Tezos

These are the sources of the protocol of Tezos imported to Coq by the current development version of coq-of-ocaml. Tezos is a crypto-currency with smart-contracts and an upgradable protocol.

We show the original source code on the left and the imported Coq code on the right. The imported code does not compile. This is due to either various incompleteness in our tool, or to side-effects in the source code. Write at web [at] clarus [dot] me for more information. Work currently made at Nomadic Labs.

alpha_context.ml 7 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = Raw_context.t

type context = t

module type BASIC_DATA = sig
  type t

  include Compare.S with type t := t

  val encoding : t Data_encoding.t

  val pp : Format.formatter -> t -> unit
end

module Tez = Tez_repr
module Period = Period_repr

module Timestamp = struct
  include Time_repr

  let current = Raw_context.current_timestamp
end

include Operation_repr

module Operation = struct
  type 'kind t = 'kind operation = {
    shell : Operation.shell_header;
    protocol_data : 'kind protocol_data;
  }

  type packed = packed_operation

  let unsigned_encoding = unsigned_operation_encoding

  include Operation_repr
end

module Block_header = Block_header_repr

module Vote = struct
  include Vote_repr
  include Vote_storage
end

module Raw_level = Raw_level_repr
module Cycle = Cycle_repr
module Script_int = Script_int_repr

module Script_timestamp = struct
  include Script_timestamp_repr

  let now ctxt =
    let {Constants_repr.time_between_blocks; _} = Raw_context.constants ctxt in
    match time_between_blocks with
    | [] ->
        failwith
          "Internal error: 'time_between_block' constants is an empty list."
    | first_delay :: _ ->
        let current_timestamp = Raw_context.predecessor_timestamp ctxt in
        Time.add current_timestamp (Period_repr.to_seconds first_delay)
        |> Timestamp.to_seconds |> of_int64
end

module Script = struct
  include Michelson_v1_primitives
  include Script_repr

  let force_decode ctxt lexpr =
    Lwt.return
      ( Script_repr.force_decode lexpr
      >>? fun (v, cost) ->
      Raw_context.consume_gas ctxt cost >|? fun ctxt -> (v, ctxt) )

  let force_bytes ctxt lexpr =
    Lwt.return
      ( Script_repr.force_bytes lexpr
      >>? fun (b, cost) ->
      Raw_context.consume_gas ctxt cost >|? fun ctxt -> (b, ctxt) )

  module Legacy_support = Legacy_script_support_repr
end

module Fees = Fees_storage

type public_key = Signature.Public_key.t

type public_key_hash = Signature.Public_key_hash.t

type signature = Signature.t

module Constants = struct
  include Constants_repr
  include Constants_storage
end

module Voting_period = Voting_period_repr

module Gas = struct
  include Gas_limit_repr

  type error += Gas_limit_too_high = Raw_context.Gas_limit_too_high

  let check_limit = Raw_context.check_gas_limit

  let set_limit = Raw_context.set_gas_limit

  let set_unlimited = Raw_context.set_gas_unlimited

  let consume = Raw_context.consume_gas

  let check_enough = Raw_context.check_enough_gas

  let level = Raw_context.gas_level

  let consumed = Raw_context.gas_consumed

  let block_level = Raw_context.block_gas_level
end

module Level = struct
  include Level_repr
  include Level_storage
end

module Contract = struct
  include Contract_repr
  include Contract_storage

  let originate c contract ~balance ~script ~delegate =
    originate c contract ~balance ~script ~delegate

  let init_origination_nonce = Raw_context.init_origination_nonce

  let unset_origination_nonce = Raw_context.unset_origination_nonce
end

module Big_map = struct
  type id = Z.t

  let fresh = Storage.Big_map.Next.incr

  let fresh_temporary = Raw_context.fresh_temporary_big_map

  let mem c m k = Storage.Big_map.Contents.mem (c, m) k

  let get_opt c m k = Storage.Big_map.Contents.get_option (c, m) k

  let rpc_arg = Storage.Big_map.rpc_arg

  let cleanup_temporary c =
    Raw_context.temporary_big_maps c Storage.Big_map.remove_rec c
    >>= fun c -> Lwt.return (Raw_context.reset_temporary_big_map c)

  let exists c id =
    Lwt.return
      (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero))
    >>=? fun c ->
    Storage.Big_map.Key_type.get_option c id
    >>=? fun kt ->
    match kt with
    | None ->
        return (c, None)
    | Some kt ->
        Storage.Big_map.Value_type.get c id
        >>=? fun kv -> return (c, Some (kt, kv))
end

module Delegate = Delegate_storage

module Roll = struct
  include Roll_repr
  include Roll_storage
end

module Nonce = Nonce_storage

module Seed = struct
  include Seed_repr
  include Seed_storage
end

module Fitness = struct
  include Fitness_repr
  include Fitness

  type fitness = t

  include Fitness_storage
end

module Bootstrap = Bootstrap_storage

module Commitment = struct
  include Commitment_repr
  include Commitment_storage
end

module Global = struct
  let get_block_priority = Storage.Block_priority.get

  let set_block_priority = Storage.Block_priority.set
end

let prepare_first_block = Init_storage.prepare_first_block

let prepare = Init_storage.prepare

let finalize ?commit_message:message c =
  let fitness = Fitness.from_int64 (Fitness.current c) in
  let context = Raw_context.recover c in
  {
    Updater.context;
    fitness;
    message;
    max_operations_ttl = 60;
    last_allowed_fork_level =
      Raw_level.to_int32 @@ Level.last_allowed_fork_level c;
  }

let activate = Raw_context.activate

let fork_test_chain = Raw_context.fork_test_chain

let record_endorsement = Raw_context.record_endorsement

let allowed_endorsements = Raw_context.allowed_endorsements

let init_endorsements = Raw_context.init_endorsements

let included_endorsements = Raw_context.included_endorsements

let reset_internal_nonce = Raw_context.reset_internal_nonce

let fresh_internal_nonce = Raw_context.fresh_internal_nonce

let record_internal_nonce = Raw_context.record_internal_nonce

let internal_nonce_already_recorded =
  Raw_context.internal_nonce_already_recorded

let add_deposit = Raw_context.add_deposit

let add_fees = Raw_context.add_fees

let add_rewards = Raw_context.add_rewards

let get_deposits = Raw_context.get_deposits

let get_fees = Raw_context.get_fees

let get_rewards = Raw_context.get_rewards

let description = Raw_context.description
alpha_context_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition t := Tezos_raw_protocol_alpha.Raw_context.t.

Definition context := t.

Module BASIC_DATA.
  Record signature {t : Type} := {
    t := t;
    op_eq : t -> t -> bool;
    op_ltgt : t -> t -> bool;
    op_lt : t -> t -> bool;
    op_lteq : t -> t -> bool;
    op_gteq : t -> t -> bool;
    op_gt : t -> t -> bool;
    compare : t -> t -> Z;
    equal : t -> t -> bool;
    max : t -> t -> t;
    min : t -> t -> t;
    encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t t;
    pp : Tezos_protocol_environment_alpha__Environment.Format.formatter ->
      t -> unit;
  }.
  Arguments signature : clear implicits.
End BASIC_DATA.

Module Tez := Tez_repr.

Module Period := Period_repr.

Module Timestamp.
  Export Time_repr.
  
  Definition current
    : Tezos_raw_protocol_alpha.Raw_context.context ->
      Tezos_protocol_environment_alpha__Environment.Time.t :=
    Raw_context.current_timestamp.
End Timestamp.

Export Operation_repr.

Module Operation.
  Record t {kind : Type} := {
    shell : Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
    protocol_data : protocol_data kind }.
  Arguments t : clear implicits.
  
  Definition packed := packed_operation.
  
  Definition unsigned_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
      (Tezos_protocol_environment_alpha__Environment.Operation.shell_header *
        packed_contents_list) := unsigned_operation_encoding.
  
  Export Operation_repr.
End Operation.

Module Block_header := Block_header_repr.

Module Vote.
  Export Vote_repr.
  
  Export Vote_storage.
End Vote.

Module Raw_level := Raw_level_repr.

Module Cycle := Cycle_repr.

Module Script_int := Script_int_repr.

Module Script_timestamp.
  Export Script_timestamp_repr.
  
  Definition now (ctxt : Tezos_raw_protocol_alpha.Raw_context.context) : t :=
    let '{| Constants_repr.time_between_blocks := time_between_blocks |} :=
      Raw_context.constants ctxt in
    match time_between_blocks with
    | [] =>
      failwith
        "Internal error: 'time_between_block' constants is an empty list." %
          string
    | cons first_delay _ =>
      let current_timestamp := Raw_context.predecessor_timestamp ctxt in
      op_pipegt
        (op_pipegt
          (Time.add current_timestamp (Period_repr.to_seconds first_delay))
          Timestamp.to_seconds) of_int64
    end.
End Script_timestamp.

Module Script.
  Export Michelson_v1_primitives.
  
  Export Script_repr.
  
  Definition force_decode
    (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
    (lexpr : Tezos_raw_protocol_alpha.Script_repr.lazy_expr)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Script_repr.expr *
          Tezos_raw_protocol_alpha.Raw_context.context)) :=
    Lwt.__return
      (op_gtgtquestion (Script_repr.force_decode lexpr)
        (fun function_parameter =>
          let '(v, cost) := function_parameter in
          op_gtpipequestion (Raw_context.consume_gas ctxt cost)
            (fun ctxt => (v, ctxt)))).
  
  Definition force_bytes
    (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
    (lexpr : Tezos_raw_protocol_alpha.Script_repr.lazy_expr)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_protocol_environment_alpha__Environment.MBytes.t *
          Tezos_raw_protocol_alpha.Raw_context.context)) :=
    Lwt.__return
      (op_gtgtquestion (Script_repr.force_bytes lexpr)
        (fun function_parameter =>
          let '(b, cost) := function_parameter in
          op_gtpipequestion (Raw_context.consume_gas ctxt cost)
            (fun ctxt => (b, ctxt)))).
  
  Module Legacy_support := Legacy_script_support_repr.
End Script.

Module Fees := Fees_storage.

Definition public_key :=
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t.

Definition public_key_hash :=
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t.

Definition signature :=
  Tezos_protocol_environment_alpha__Environment.Signature.t.

Module Constants.
  Export Constants_repr.
  
  Export Constants_storage.
End Constants.

Module Voting_period := Voting_period_repr.

Module Gas.
  Export Gas_limit_repr.
  
  (* ❌ Structure item `typext` not handled. *)
  type_extension
  
  Definition check_limit
    : Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_protocol_environment_alpha__Environment.Z.t ->
        Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
    Raw_context.check_gas_limit.
  
  Definition set_limit
    : Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_protocol_environment_alpha__Environment.Z.t ->
        Tezos_raw_protocol_alpha.Raw_context.t := Raw_context.set_gas_limit.
  
  Definition set_unlimited
    : Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_raw_protocol_alpha.Raw_context.t := Raw_context.set_gas_unlimited.
  
  Definition consume
    : Tezos_raw_protocol_alpha.Raw_context.context ->
      Tezos_raw_protocol_alpha.Gas_limit_repr.cost ->
        Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.context :=
    Raw_context.consume_gas.
  
  Definition check_enough
    : Tezos_raw_protocol_alpha.Raw_context.context ->
      Tezos_raw_protocol_alpha.Gas_limit_repr.cost ->
        Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
    Raw_context.check_enough_gas.
  
  Definition level
    : Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_raw_protocol_alpha.Gas_limit_repr.t := Raw_context.gas_level.
  
  Definition consumed
    : Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_raw_protocol_alpha.Raw_context.t ->
        Tezos_protocol_environment_alpha__Environment.Z.t :=
    Raw_context.gas_consumed.
  
  Definition block_level
    : Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_protocol_environment_alpha__Environment.Z.t :=
    Raw_context.block_gas_level.
End Gas.

Module Level.
  Export Level_repr.
  
  Export Level_storage.
End Level.

Module Contract.
  Export Contract_repr.
  
  Export Contract_storage.
  
  Definition originate
    (c : Tezos_raw_protocol_alpha.Raw_context.t)
    (contract : Tezos_raw_protocol_alpha.Contract_repr.t)
    (balance : Tezos_raw_protocol_alpha.Tez_repr.t)
    (script : Tezos_raw_protocol_alpha.Script_repr.t * option big_map_diff)
    (delegate :
      option
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t) :=
    originate c None contract balance script delegate.
  
  Definition init_origination_nonce
    : Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
        -> Tezos_raw_protocol_alpha.Raw_context.t :=
    Raw_context.init_origination_nonce.
  
  Definition unset_origination_nonce
    : Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_raw_protocol_alpha.Raw_context.t :=
    Raw_context.unset_origination_nonce.
End Contract.

Module Big_map.
  Definition id := Tezos_protocol_environment_alpha__Environment.Z.t.
  
  Definition fresh
    : Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t *
            Tezos_protocol_environment_alpha__Environment.Z.t)) :=
    Storage.Big_map.Next.incr.
  
  Definition fresh_temporary
    : Tezos_raw_protocol_alpha.Raw_context.context ->
      Tezos_raw_protocol_alpha.Raw_context.context *
        Tezos_protocol_environment_alpha__Environment.Z.t :=
    Raw_context.fresh_temporary_big_map.
  
  Definition mem
    (c : Tezos_raw_protocol_alpha.Raw_context.t)
    (m : Tezos_protocol_environment_alpha__Environment.Z.t)
    (k : Tezos_raw_protocol_alpha.Storage.Big_map.Contents.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Raw_context.t * bool)) :=
    Storage.Big_map.Contents.mem (c, m) k.
  
  Definition get_opt
    (c : Tezos_raw_protocol_alpha.Raw_context.t)
    (m : Tezos_protocol_environment_alpha__Environment.Z.t)
    (k : Tezos_raw_protocol_alpha.Storage.Big_map.Contents.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Raw_context.t *
          option Tezos_raw_protocol_alpha.Storage.Big_map.Contents.value)) :=
    Storage.Big_map.Contents.get_option (c, m) k.
  
  Definition rpc_arg
    : Tezos_protocol_environment_alpha__Environment.RPC_arg.t
      Tezos_protocol_environment_alpha__Environment.Z.t :=
    Storage.Big_map.rpc_arg.
  
  Definition cleanup_temporary
    (c : Tezos_raw_protocol_alpha.Raw_context.context)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.context :=
    op_gtgteq (Raw_context.temporary_big_maps c Storage.Big_map.remove_rec c)
      (fun c => Lwt.__return (Raw_context.reset_temporary_big_map c)).
  
  Definition __exists
    (c : Tezos_raw_protocol_alpha.Raw_context.context)
    (id : Tezos_raw_protocol_alpha.Storage.Big_map.Key_type.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Raw_context.context *
          option
            (Tezos_raw_protocol_alpha.Storage.Big_map.Key_type.value *
              Tezos_raw_protocol_alpha.Storage.Big_map.Value_type.value))) :=
    op_gtgteqquestion
      (Lwt.__return
        (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero)))
      (fun c =>
        op_gtgteqquestion (Storage.Big_map.Key_type.get_option c id)
          (fun kt =>
            match kt with
            | None => __return (c, None)
            | Some kt =>
              op_gtgteqquestion (Storage.Big_map.Value_type.get c id)
                (fun kv => __return (c, (Some (kt, kv))))
            end)).
End Big_map.

Module Delegate := Delegate_storage.

Module Roll.
  Export Roll_repr.
  
  Export Roll_storage.
End Roll.

Module Nonce := Nonce_storage.

Module Seed.
  Export Seed_repr.
  
  Export Seed_storage.
End Seed.

Module Fitness.
  Export Fitness_repr.
  
  Export Fitness.
  
  Definition fitness := t.
  
  Export Fitness_storage.
End Fitness.

Module Bootstrap := Bootstrap_storage.

Module Commitment.
  Export Commitment_repr.
  
  Export Commitment_storage.
End Commitment.

Module Global.
  Definition get_block_priority
    : Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z) :=
    Storage.Block_priority.get.
  
  Definition set_block_priority
    : Tezos_raw_protocol_alpha.Raw_context.t ->
      Z ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Raw_context.t) :=
    Storage.Block_priority.set.
End Global.

Definition prepare_first_block
  : Tezos_protocol_environment_alpha__Environment.Context.t ->
    (Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_raw_protocol_alpha.Script_repr.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            ((Tezos_raw_protocol_alpha.Script_repr.t *
              option Tezos_raw_protocol_alpha.Contract_storage.big_map_diff) *
              Tezos_raw_protocol_alpha.Raw_context.t))) ->
      int32 ->
        Tezos_protocol_environment_alpha__Environment.Time.t ->
          Tezos_protocol_environment_alpha__Environment.Fitness.(Tezos_protocol_environment_alpha__Environment.T.S.t)
            ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                Tezos_raw_protocol_alpha.Raw_context.t) :=
  Init_storage.prepare_first_block.

Definition prepare
  : Tezos_protocol_environment_alpha__Environment.Context.t ->
    Tezos_protocol_environment_alpha__Environment.Int32.t ->
      Tezos_protocol_environment_alpha__Environment.Time.t ->
        Tezos_protocol_environment_alpha__Environment.Time.t ->
          Tezos_protocol_environment_alpha__Environment.Fitness.(Tezos_protocol_environment_alpha__Environment.T.S.t)
            ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                Tezos_raw_protocol_alpha.Raw_context.context) :=
  Init_storage.prepare.

Definition finalize
  (message : option string) (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_protocol_environment_alpha__Environment.Updater.validation_result :=
  let fitness := Fitness.from_int64 (Fitness.current c) in
  let context := Raw_context.recover c in
  {| Updater.context := context; Updater.fitness := fitness;
    Updater.message := message; Updater.max_operations_ttl := 60;
    Updater.last_allowed_fork_level :=
      op_atat Raw_level.to_int32 (Level.last_allowed_fork_level c) |}.

Definition activate
  : Tezos_raw_protocol_alpha.Raw_context.context ->
    Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
      ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t := Raw_context.activate.

Definition fork_test_chain
  : Tezos_raw_protocol_alpha.Raw_context.context ->
    Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
      ->
      Tezos_protocol_environment_alpha__Environment.Time.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          Tezos_raw_protocol_alpha.Raw_context.t := Raw_context.fork_test_chain.

Definition record_endorsement
  : Tezos_raw_protocol_alpha.Raw_context.context ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_raw_protocol_alpha.Raw_context.context :=
  Raw_context.record_endorsement.

Definition allowed_endorsements
  : Tezos_raw_protocol_alpha.Raw_context.context ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
        list Z * bool) := Raw_context.allowed_endorsements.

Definition init_endorsements
  : Tezos_raw_protocol_alpha.Raw_context.context ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
        list Z * bool) -> Tezos_raw_protocol_alpha.Raw_context.context :=
  Raw_context.init_endorsements.

Definition included_endorsements
  : Tezos_raw_protocol_alpha.Raw_context.context -> Z :=
  Raw_context.included_endorsements.

Definition reset_internal_nonce
  : Tezos_raw_protocol_alpha.Raw_context.context ->
    Tezos_raw_protocol_alpha.Raw_context.context :=
  Raw_context.reset_internal_nonce.

Definition fresh_internal_nonce
  : Tezos_raw_protocol_alpha.Raw_context.context ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.context * Z) :=
  Raw_context.fresh_internal_nonce.

Definition record_internal_nonce
  : Tezos_raw_protocol_alpha.Raw_context.context ->
    Z -> Tezos_raw_protocol_alpha.Raw_context.context :=
  Raw_context.record_internal_nonce.

Definition internal_nonce_already_recorded
  : Tezos_raw_protocol_alpha.Raw_context.context -> Z -> bool :=
  Raw_context.internal_nonce_already_recorded.

Definition add_deposit
  : Tezos_raw_protocol_alpha.Raw_context.context ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_raw_protocol_alpha.Tez_repr.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Raw_context.context) :=
  Raw_context.add_deposit.

Definition add_fees
  : Tezos_raw_protocol_alpha.Raw_context.context ->
    Tezos_raw_protocol_alpha.Tez_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.context) := Raw_context.add_fees.

Definition add_rewards
  : Tezos_raw_protocol_alpha.Raw_context.context ->
    Tezos_raw_protocol_alpha.Tez_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.context) :=
  Raw_context.add_rewards.

Definition get_deposits
  : Tezos_raw_protocol_alpha.Raw_context.context ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
      Tezos_raw_protocol_alpha.Tez_repr.t := Raw_context.get_deposits.

Definition get_fees
  : Tezos_raw_protocol_alpha.Raw_context.context ->
    Tezos_raw_protocol_alpha.Tez_repr.t := Raw_context.get_fees.

Definition get_rewards
  : Tezos_raw_protocol_alpha.Raw_context.context ->
    Tezos_raw_protocol_alpha.Tez_repr.t := Raw_context.get_rewards.

Definition description
  : Tezos_raw_protocol_alpha.Storage_description.t
    Tezos_raw_protocol_alpha.Raw_context.context := Raw_context.description.
alpha_context.mli 60 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

module type BASIC_DATA = sig
  type t

  include Compare.S with type t := t

  val encoding : t Data_encoding.t

  val pp : Format.formatter -> t -> unit
end

type t

type context = t

type public_key = Signature.Public_key.t

type public_key_hash = Signature.Public_key_hash.t

type signature = Signature.t

module Tez : sig
  include BASIC_DATA

  type tez = t

  val zero : tez

  val one_mutez : tez

  val one_cent : tez

  val fifty_cents : tez

  val one : tez

  val ( -? ) : tez -> tez -> tez tzresult

  val ( +? ) : tez -> tez -> tez tzresult

  val ( *? ) : tez -> int64 -> tez tzresult

  val ( /? ) : tez -> int64 -> tez tzresult

  val of_string : string -> tez option

  val to_string : tez -> string

  val of_mutez : int64 -> tez option

  val to_mutez : tez -> int64
end

module Period : sig
  include BASIC_DATA

  type period = t

  val rpc_arg : period RPC_arg.arg

  val of_seconds : int64 -> period tzresult

  val to_seconds : period -> int64

  val mult : int32 -> period -> period tzresult

  val zero : period

  val one_second : period

  val one_minute : period

  val one_hour : period
end

module Timestamp : sig
  include BASIC_DATA with type t = Time.t

  type time = t

  val ( +? ) : time -> Period.t -> time tzresult

  val ( -? ) : time -> time -> Period.t tzresult

  val of_notation : string -> time option

  val to_notation : time -> string

  val of_seconds : string -> time option

  val to_seconds_string : time -> string

  val current : context -> time
end

module Raw_level : sig
  include BASIC_DATA

  type raw_level = t

  val rpc_arg : raw_level RPC_arg.arg

  val diff : raw_level -> raw_level -> int32

  val root : raw_level

  val succ : raw_level -> raw_level

  val pred : raw_level -> raw_level option

  val to_int32 : raw_level -> int32

  val of_int32 : int32 -> raw_level tzresult
end

module Cycle : sig
  include BASIC_DATA

  type cycle = t

  val rpc_arg : cycle RPC_arg.arg

  val root : cycle

  val succ : cycle -> cycle

  val pred : cycle -> cycle option

  val add : cycle -> int -> cycle

  val sub : cycle -> int -> cycle option

  val to_int32 : cycle -> int32

  module Map : S.MAP with type key = cycle
end

module Gas : sig
  type t = private Unaccounted | Limited of {remaining : Z.t}

  val encoding : t Data_encoding.encoding

  val pp : Format.formatter -> t -> unit

  type cost

  val cost_encoding : cost Data_encoding.encoding

  val pp_cost : Format.formatter -> cost -> unit

  type error += Block_quota_exceeded (* `Temporary *)

  type error += Operation_quota_exceeded (* `Temporary *)

  type error += Gas_limit_too_high (* `Permanent *)

  val free : cost

  val atomic_step_cost : int -> cost

  val step_cost : int -> cost

  val alloc_cost : int -> cost

  val alloc_bytes_cost : int -> cost

  val alloc_mbytes_cost : int -> cost

  val alloc_bits_cost : int -> cost

  val read_bytes_cost : Z.t -> cost

  val write_bytes_cost : Z.t -> cost

  val ( *@ ) : int -> cost -> cost

  val ( +@ ) : cost -> cost -> cost

  val check_limit : context -> Z.t -> unit tzresult

  val set_limit : context -> Z.t -> context

  val set_unlimited : context -> context

  val consume : context -> cost -> context tzresult

  val check_enough : context -> cost -> unit tzresult

  val level : context -> t

  val consumed : since:context -> until:context -> Z.t

  val block_level : context -> Z.t
end

module Script_int : module type of Script_int_repr

module Script_timestamp : sig
  open Script_int

  type t

  val compare : t -> t -> int

  val to_string : t -> string

  val to_notation : t -> string option

  val to_num_str : t -> string

  val of_string : string -> t option

  val diff : t -> t -> z num

  val add_delta : t -> z num -> t

  val sub_delta : t -> z num -> t

  val now : context -> t

  val to_zint : t -> Z.t

  val of_zint : Z.t -> t
end

module Script : sig
  type prim = Michelson_v1_primitives.prim =
    | K_parameter
    | K_storage
    | K_code
    | D_False
    | D_Elt
    | D_Left
    | D_None
    | D_Pair
    | D_Right
    | D_Some
    | D_True
    | D_Unit
    | I_PACK
    | I_UNPACK
    | I_BLAKE2B
    | I_SHA256
    | I_SHA512
    | I_ABS
    | I_ADD
    | I_AMOUNT
    | I_AND
    | I_BALANCE
    | I_CAR
    | I_CDR
    | I_CHAIN_ID
    | I_CHECK_SIGNATURE
    | I_COMPARE
    | I_CONCAT
    | I_CONS
    | I_CREATE_ACCOUNT
    | I_CREATE_CONTRACT
    | I_IMPLICIT_ACCOUNT
    | I_DIP
    | I_DROP
    | I_DUP
    | I_EDIV
    | I_EMPTY_BIG_MAP
    | I_EMPTY_MAP
    | I_EMPTY_SET
    | I_EQ
    | I_EXEC
    | I_APPLY
    | I_FAILWITH
    | I_GE
    | I_GET
    | I_GT
    | I_HASH_KEY
    | I_IF
    | I_IF_CONS
    | I_IF_LEFT
    | I_IF_NONE
    | I_INT
    | I_LAMBDA
    | I_LE
    | I_LEFT
    | I_LOOP
    | I_LSL
    | I_LSR
    | I_LT
    | I_MAP
    | I_MEM
    | I_MUL
    | I_NEG
    | I_NEQ
    | I_NIL
    | I_NONE
    | I_NOT
    | I_NOW
    | I_OR
    | I_PAIR
    | I_PUSH
    | I_RIGHT
    | I_SIZE
    | I_SOME
    | I_SOURCE
    | I_SENDER
    | I_SELF
    | I_SLICE
    | I_STEPS_TO_QUOTA
    | I_SUB
    | I_SWAP
    | I_TRANSFER_TOKENS
    | I_SET_DELEGATE
    | I_UNIT
    | I_UPDATE
    | I_XOR
    | I_ITER
    | I_LOOP_LEFT
    | I_ADDRESS
    | I_CONTRACT
    | I_ISNAT
    | I_CAST
    | I_RENAME
    | I_DIG
    | I_DUG
    | T_bool
    | T_contract
    | T_int
    | T_key
    | T_key_hash
    | T_lambda
    | T_list
    | T_map
    | T_big_map
    | T_nat
    | T_option
    | T_or
    | T_pair
    | T_set
    | T_signature
    | T_string
    | T_bytes
    | T_mutez
    | T_timestamp
    | T_unit
    | T_operation
    | T_address
    | T_chain_id

  type location = Micheline.canonical_location

  type annot = Micheline.annot

  type expr = prim Micheline.canonical

  type lazy_expr = expr Data_encoding.lazy_t

  val lazy_expr : expr -> lazy_expr

  type node = (location, prim) Micheline.node

  type t = {code : lazy_expr; storage : lazy_expr}

  val location_encoding : location Data_encoding.t

  val expr_encoding : expr Data_encoding.t

  val prim_encoding : prim Data_encoding.t

  val encoding : t Data_encoding.t

  val lazy_expr_encoding : lazy_expr Data_encoding.t

  val deserialized_cost : expr -> Gas.cost

  val serialized_cost : MBytes.t -> Gas.cost

  val traversal_cost : node -> Gas.cost

  val node_cost : node -> Gas.cost

  val int_node_cost : Z.t -> Gas.cost

  val int_node_cost_of_numbits : int -> Gas.cost

  val string_node_cost : string -> Gas.cost

  val string_node_cost_of_length : int -> Gas.cost

  val bytes_node_cost : MBytes.t -> Gas.cost

  val bytes_node_cost_of_length : int -> Gas.cost

  val prim_node_cost_nonrec : expr list -> annot -> Gas.cost

  val prim_node_cost_nonrec_of_length : int -> annot -> Gas.cost

  val seq_node_cost_nonrec : expr list -> Gas.cost

  val seq_node_cost_nonrec_of_length : int -> Gas.cost

  val minimal_deserialize_cost : lazy_expr -> Gas.cost

  val force_decode : context -> lazy_expr -> (expr * context) tzresult Lwt.t

  val force_bytes : context -> lazy_expr -> (MBytes.t * context) tzresult Lwt.t

  val unit_parameter : lazy_expr

  module Legacy_support : sig
    val manager_script_code : lazy_expr

    val add_do :
      manager_pkh:Signature.Public_key_hash.t ->
      script_code:lazy_expr ->
      script_storage:lazy_expr ->
      (lazy_expr * lazy_expr) tzresult Lwt.t

    val add_set_delegate :
      manager_pkh:Signature.Public_key_hash.t ->
      script_code:lazy_expr ->
      script_storage:lazy_expr ->
      (lazy_expr * lazy_expr) tzresult Lwt.t

    val has_default_entrypoint : lazy_expr -> bool

    val add_root_entrypoint : script_code:lazy_expr -> lazy_expr tzresult Lwt.t
  end
end

module Constants : sig
  (** Fixed constants *)
  type fixed = {
    proof_of_work_nonce_size : int;
    nonce_length : int;
    max_revelations_per_block : int;
    max_operation_data_length : int;
    max_proposals_per_delegate : int;
  }

  val fixed_encoding : fixed Data_encoding.t

  val fixed : fixed

  val proof_of_work_nonce_size : int

  val nonce_length : int

  val max_revelations_per_block : int

  val max_operation_data_length : int

  val max_proposals_per_delegate : int

  (** Constants parameterized by context *)
  type parametric = {
    preserved_cycles : int;
    blocks_per_cycle : int32;
    blocks_per_commitment : int32;
    blocks_per_roll_snapshot : int32;
    blocks_per_voting_period : int32;
    time_between_blocks : Period.t list;
    endorsers_per_block : int;
    hard_gas_limit_per_operation : Z.t;
    hard_gas_limit_per_block : Z.t;
    proof_of_work_threshold : int64;
    tokens_per_roll : Tez.t;
    michelson_maximum_type_size : int;
    seed_nonce_revelation_tip : Tez.t;
    origination_size : int;
    block_security_deposit : Tez.t;
    endorsement_security_deposit : Tez.t;
    block_reward : Tez.t;
    endorsement_reward : Tez.t;
    cost_per_byte : Tez.t;
    hard_storage_limit_per_operation : Z.t;
    test_chain_duration : int64;
    quorum_min : int32;
    quorum_max : int32;
    min_proposal_quorum : int32;
    initial_endorsers : int;
    delay_per_missing_endorsement : Period.t;
  }

  val parametric_encoding : parametric Data_encoding.t

  val parametric : context -> parametric

  val preserved_cycles : context -> int

  val blocks_per_cycle : context -> int32

  val blocks_per_commitment : context -> int32

  val blocks_per_roll_snapshot : context -> int32

  val blocks_per_voting_period : context -> int32

  val time_between_blocks : context -> Period.t list

  val endorsers_per_block : context -> int

  val initial_endorsers : context -> int

  val delay_per_missing_endorsement : context -> Period.t

  val hard_gas_limit_per_operation : context -> Z.t

  val hard_gas_limit_per_block : context -> Z.t

  val cost_per_byte : context -> Tez.t

  val hard_storage_limit_per_operation : context -> Z.t

  val proof_of_work_threshold : context -> int64

  val tokens_per_roll : context -> Tez.t

  val michelson_maximum_type_size : context -> int

  val block_reward : context -> Tez.t

  val endorsement_reward : context -> Tez.t

  val seed_nonce_revelation_tip : context -> Tez.t

  val origination_size : context -> int

  val block_security_deposit : context -> Tez.t

  val endorsement_security_deposit : context -> Tez.t

  val test_chain_duration : context -> int64

  val quorum_min : context -> int32

  val quorum_max : context -> int32

  val min_proposal_quorum : context -> int32

  (** All constants: fixed and parametric *)
  type t = {fixed : fixed; parametric : parametric}

  val encoding : t Data_encoding.t
end

module Voting_period : sig
  include BASIC_DATA

  type voting_period = t

  val rpc_arg : voting_period RPC_arg.arg

  val root : voting_period

  val succ : voting_period -> voting_period

  type kind = Proposal | Testing_vote | Testing | Promotion_vote

  val kind_encoding : kind Data_encoding.encoding

  val to_int32 : voting_period -> int32
end

module Level : sig
  type t = private {
    level : Raw_level.t;
    level_position : int32;
    cycle : Cycle.t;
    cycle_position : int32;
    voting_period : Voting_period.t;
    voting_period_position : int32;
    expected_commitment : bool;
  }

  include BASIC_DATA with type t := t

  val pp_full : Format.formatter -> t -> unit

  type level = t

  val root : context -> level

  val succ : context -> level -> level

  val pred : context -> level -> level option

  val from_raw : context -> ?offset:int32 -> Raw_level.t -> level

  val diff : level -> level -> int32

  val current : context -> level

  val last_level_in_cycle : context -> Cycle.t -> level

  val levels_in_cycle : context -> Cycle.t -> level list

  val levels_in_current_cycle : context -> ?offset:int32 -> unit -> level list

  val last_allowed_fork_level : context -> Raw_level.t
end

module Fitness : sig
  include module type of Fitness

  type fitness = t

  val increase : ?gap:int -> context -> context

  val current : context -> int64

  val to_int64 : fitness -> int64 tzresult
end

module Nonce : sig
  type t

  type nonce = t

  val encoding : nonce Data_encoding.t

  type unrevealed = {
    nonce_hash : Nonce_hash.t;
    delegate : public_key_hash;
    rewards : Tez.t;
    fees : Tez.t;
  }

  val record_hash : context -> unrevealed -> context tzresult Lwt.t

  val reveal : context -> Level.t -> nonce -> context tzresult Lwt.t

  type status = Unrevealed of unrevealed | Revealed of nonce

  val get : context -> Level.t -> status tzresult Lwt.t

  val of_bytes : MBytes.t -> nonce tzresult

  val hash : nonce -> Nonce_hash.t

  val check_hash : nonce -> Nonce_hash.t -> bool
end

module Seed : sig
  type seed

  type error +=
    | Unknown of {oldest : Cycle.t; cycle : Cycle.t; latest : Cycle.t}

  val for_cycle : context -> Cycle.t -> seed tzresult Lwt.t

  val cycle_end :
    context -> Cycle.t -> (context * Nonce.unrevealed list) tzresult Lwt.t

  val seed_encoding : seed Data_encoding.t
end

module Big_map : sig
  type id = Z.t

  val fresh : context -> (context * id) tzresult Lwt.t

  val fresh_temporary : context -> context * id

  val mem :
    context -> id -> Script_expr_hash.t -> (context * bool) tzresult Lwt.t

  val get_opt :
    context ->
    id ->
    Script_expr_hash.t ->
    (context * Script.expr option) tzresult Lwt.t

  val rpc_arg : id RPC_arg.t

  val cleanup_temporary : context -> context Lwt.t

  val exists :
    context ->
    id ->
    (context * (Script.expr * Script.expr) option) tzresult Lwt.t
end

module Contract : sig
  include BASIC_DATA

  type contract = t

  val rpc_arg : contract RPC_arg.arg

  val to_b58check : contract -> string

  val of_b58check : string -> contract tzresult

  val implicit_contract : public_key_hash -> contract

  val is_implicit : contract -> public_key_hash option

  val exists : context -> contract -> bool tzresult Lwt.t

  val must_exist : context -> contract -> unit tzresult Lwt.t

  val allocated : context -> contract -> bool tzresult Lwt.t

  val must_be_allocated : context -> contract -> unit tzresult Lwt.t

  val list : context -> contract list Lwt.t

  val get_manager_key : context -> public_key_hash -> public_key tzresult Lwt.t

  val is_manager_key_revealed :
    context -> public_key_hash -> bool tzresult Lwt.t

  val reveal_manager_key :
    context -> public_key_hash -> public_key -> context tzresult Lwt.t

  val get_script_code :
    context -> contract -> (context * Script.lazy_expr option) tzresult Lwt.t

  val get_script :
    context -> contract -> (context * Script.t option) tzresult Lwt.t

  val get_storage :
    context -> contract -> (context * Script.expr option) tzresult Lwt.t

  val get_counter : context -> public_key_hash -> Z.t tzresult Lwt.t

  val get_balance : context -> contract -> Tez.t tzresult Lwt.t

  val init_origination_nonce : context -> Operation_hash.t -> context

  val unset_origination_nonce : context -> context

  val fresh_contract_from_current_nonce :
    context -> (context * t) tzresult Lwt.t

  val originated_from_current_nonce :
    since:context -> until:context -> contract list tzresult Lwt.t

  type big_map_diff_item =
    | Update of {
        big_map : Big_map.id;
        diff_key : Script.expr;
        diff_key_hash : Script_expr_hash.t;
        diff_value : Script.expr option;
      }
    | Clear of Big_map.id
    | Copy of Big_map.id * Big_map.id
    | Alloc of {
        big_map : Big_map.id;
        key_type : Script.expr;
        value_type : Script.expr;
      }

  type big_map_diff = big_map_diff_item list

  val big_map_diff_encoding : big_map_diff Data_encoding.t

  val originate :
    context ->
    contract ->
    balance:Tez.t ->
    script:Script.t * big_map_diff option ->
    delegate:public_key_hash option ->
    context tzresult Lwt.t

  type error += Balance_too_low of contract * Tez.t * Tez.t

  val spend : context -> contract -> Tez.t -> context tzresult Lwt.t

  val credit : context -> contract -> Tez.t -> context tzresult Lwt.t

  val update_script_storage :
    context ->
    contract ->
    Script.expr ->
    big_map_diff option ->
    context tzresult Lwt.t

  val used_storage_space : context -> t -> Z.t tzresult Lwt.t

  val increment_counter : context -> public_key_hash -> context tzresult Lwt.t

  val check_counter_increment :
    context -> public_key_hash -> Z.t -> unit tzresult Lwt.t

  (**/**)

  (* Only for testing *)
  type origination_nonce

  val initial_origination_nonce : Operation_hash.t -> origination_nonce

  val originated_contract : origination_nonce -> contract
end

module Delegate : sig
  type balance =
    | Contract of Contract.t
    | Rewards of Signature.Public_key_hash.t * Cycle.t
    | Fees of Signature.Public_key_hash.t * Cycle.t
    | Deposits of Signature.Public_key_hash.t * Cycle.t

  type balance_update = Debited of Tez.t | Credited of Tez.t

  type balance_updates = (balance * balance_update) list

  val balance_updates_encoding : balance_updates Data_encoding.t

  val cleanup_balance_updates : balance_updates -> balance_updates

  val get : context -> Contract.t -> public_key_hash option tzresult Lwt.t

  val set :
    context -> Contract.t -> public_key_hash option -> context tzresult Lwt.t

  val fold :
    context -> init:'a -> f:(public_key_hash -> 'a -> 'a Lwt.t) -> 'a Lwt.t

  val list : context -> public_key_hash list Lwt.t

  val freeze_deposit :
    context -> public_key_hash -> Tez.t -> context tzresult Lwt.t

  val freeze_rewards :
    context -> public_key_hash -> Tez.t -> context tzresult Lwt.t

  val freeze_fees :
    context -> public_key_hash -> Tez.t -> context tzresult Lwt.t

  val cycle_end :
    context ->
    Cycle.t ->
    Nonce.unrevealed list ->
    (context * balance_updates * Signature.Public_key_hash.t list) tzresult
    Lwt.t

  type frozen_balance = {deposit : Tez.t; fees : Tez.t; rewards : Tez.t}

  val punish :
    context ->
    public_key_hash ->
    Cycle.t ->
    (context * frozen_balance) tzresult Lwt.t

  val full_balance : context -> public_key_hash -> Tez.t tzresult Lwt.t

  val has_frozen_balance :
    context -> public_key_hash -> Cycle.t -> bool tzresult Lwt.t

  val frozen_balance : context -> public_key_hash -> Tez.t tzresult Lwt.t

  val frozen_balance_encoding : frozen_balance Data_encoding.t

  val frozen_balance_by_cycle_encoding :
    frozen_balance Cycle.Map.t Data_encoding.t

  val frozen_balance_by_cycle :
    context -> Signature.Public_key_hash.t -> frozen_balance Cycle.Map.t Lwt.t

  val staking_balance :
    context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t

  val delegated_contracts :
    context -> Signature.Public_key_hash.t -> Contract_repr.t list Lwt.t

  val delegated_balance :
    context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t

  val deactivated :
    context -> Signature.Public_key_hash.t -> bool tzresult Lwt.t

  val grace_period :
    context -> Signature.Public_key_hash.t -> Cycle.t tzresult Lwt.t
end

module Vote : sig
  type proposal = Protocol_hash.t

  val record_proposal :
    context -> Protocol_hash.t -> public_key_hash -> context tzresult Lwt.t

  val get_proposals : context -> int32 Protocol_hash.Map.t tzresult Lwt.t

  val clear_proposals : context -> context Lwt.t

  val recorded_proposal_count_for_delegate :
    context -> public_key_hash -> int tzresult Lwt.t

  val listings_encoding :
    (Signature.Public_key_hash.t * int32) list Data_encoding.t

  val freeze_listings : context -> context tzresult Lwt.t

  val clear_listings : context -> context tzresult Lwt.t

  val listing_size : context -> int32 tzresult Lwt.t

  val in_listings : context -> public_key_hash -> bool Lwt.t

  val get_listings : context -> (public_key_hash * int32) list Lwt.t

  type ballot = Yay | Nay | Pass

  val ballot_encoding : ballot Data_encoding.t

  type ballots = {yay : int32; nay : int32; pass : int32}

  val ballots_encoding : ballots Data_encoding.t

  val has_recorded_ballot : context -> public_key_hash -> bool Lwt.t

  val record_ballot :
    context -> public_key_hash -> ballot -> context tzresult Lwt.t

  val get_ballots : context -> ballots tzresult Lwt.t

  val get_ballot_list :
    context -> (Signature.Public_key_hash.t * ballot) list Lwt.t

  val clear_ballots : context -> context Lwt.t

  val get_current_period_kind : context -> Voting_period.kind tzresult Lwt.t

  val set_current_period_kind :
    context -> Voting_period.kind -> context tzresult Lwt.t

  val get_current_quorum : context -> int32 tzresult Lwt.t

  val get_participation_ema : context -> int32 tzresult Lwt.t

  val set_participation_ema : context -> int32 -> context tzresult Lwt.t

  val get_current_proposal : context -> proposal tzresult Lwt.t

  val init_current_proposal : context -> proposal -> context tzresult Lwt.t

  val clear_current_proposal : context -> context tzresult Lwt.t
end

module Block_header : sig
  type t = {shell : Block_header.shell_header; protocol_data : protocol_data}

  and protocol_data = {contents : contents; signature : Signature.t}

  and contents = {
    priority : int;
    seed_nonce_hash : Nonce_hash.t option;
    proof_of_work_nonce : MBytes.t;
  }

  type block_header = t

  type raw = Block_header.t

  type shell_header = Block_header.shell_header

  val raw : block_header -> raw

  val hash : block_header -> Block_hash.t

  val hash_raw : raw -> Block_hash.t

  val encoding : block_header Data_encoding.encoding

  val raw_encoding : raw Data_encoding.t

  val contents_encoding : contents Data_encoding.t

  val unsigned_encoding : (shell_header * contents) Data_encoding.t

  val protocol_data_encoding : protocol_data Data_encoding.encoding

  val shell_header_encoding : shell_header Data_encoding.encoding

  (** The maximum size of block headers in bytes *)
  val max_header_length : int
end

module Kind : sig
  type seed_nonce_revelation = Seed_nonce_revelation_kind

  type double_endorsement_evidence = Double_endorsement_evidence_kind

  type double_baking_evidence = Double_baking_evidence_kind

  type activate_account = Activate_account_kind

  type endorsement = Endorsement_kind

  type proposals = Proposals_kind

  type ballot = Ballot_kind

  type reveal = Reveal_kind

  type transaction = Transaction_kind

  type origination = Origination_kind

  type delegation = Delegation_kind

  type 'a manager =
    | Reveal_manager_kind : reveal manager
    | Transaction_manager_kind : transaction manager
    | Origination_manager_kind : origination manager
    | Delegation_manager_kind : delegation manager
end

type 'kind operation = {
  shell : Operation.shell_header;
  protocol_data : 'kind protocol_data;
}

and 'kind protocol_data = {
  contents : 'kind contents_list;
  signature : Signature.t option;
}

and _ contents_list =
  | Single : 'kind contents -> 'kind contents_list
  | Cons :
      'kind Kind.manager contents * 'rest Kind.manager contents_list
      -> ('kind * 'rest) Kind.manager contents_list

and _ contents =
  | Endorsement : {level : Raw_level.t} -> Kind.endorsement contents
  | Seed_nonce_revelation : {
      level : Raw_level.t;
      nonce : Nonce.t;
    }
      -> Kind.seed_nonce_revelation contents
  | Double_endorsement_evidence : {
      op1 : Kind.endorsement operation;
      op2 : Kind.endorsement operation;
    }
      -> Kind.double_endorsement_evidence contents
  | Double_baking_evidence : {
      bh1 : Block_header.t;
      bh2 : Block_header.t;
    }
      -> Kind.double_baking_evidence contents
  | Activate_account : {
      id : Ed25519.Public_key_hash.t;
      activation_code : Blinded_public_key_hash.activation_code;
    }
      -> Kind.activate_account contents
  | Proposals : {
      source : Signature.Public_key_hash.t;
      period : Voting_period.t;
      proposals : Protocol_hash.t list;
    }
      -> Kind.proposals contents
  | Ballot : {
      source : Signature.Public_key_hash.t;
      period : Voting_period.t;
      proposal : Protocol_hash.t;
      ballot : Vote.ballot;
    }
      -> Kind.ballot contents
  | Manager_operation : {
      source : Signature.Public_key_hash.t;
      fee : Tez.tez;
      counter : counter;
      operation : 'kind manager_operation;
      gas_limit : Z.t;
      storage_limit : Z.t;
    }
      -> 'kind Kind.manager contents

and _ manager_operation =
  | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation
  | Transaction : {
      amount : Tez.tez;
      parameters : Script.lazy_expr;
      entrypoint : string;
      destination : Contract.contract;
    }
      -> Kind.transaction manager_operation
  | Origination : {
      delegate : Signature.Public_key_hash.t option;
      script : Script.t;
      credit : Tez.tez;
      preorigination : Contract.t option;
    }
      -> Kind.origination manager_operation
  | Delegation :
      Signature.Public_key_hash.t option
      -> Kind.delegation manager_operation

and counter = Z.t

type 'kind internal_operation = {
  source : Contract.contract;
  operation : 'kind manager_operation;
  nonce : int;
}

type packed_manager_operation =
  | Manager : 'kind manager_operation -> packed_manager_operation

type packed_contents = Contents : 'kind contents -> packed_contents

type packed_contents_list =
  | Contents_list : 'kind contents_list -> packed_contents_list

type packed_protocol_data =
  | Operation_data : 'kind protocol_data -> packed_protocol_data

type packed_operation = {
  shell : Operation.shell_header;
  protocol_data : packed_protocol_data;
}

type packed_internal_operation =
  | Internal_operation : 'kind internal_operation -> packed_internal_operation

val manager_kind : 'kind manager_operation -> 'kind Kind.manager

module Fees : sig
  val origination_burn : context -> (context * Tez.t) tzresult Lwt.t

  val record_paid_storage_space :
    context -> Contract.t -> (context * Z.t * Z.t * Tez.t) tzresult Lwt.t

  val start_counting_storage_fees : context -> context

  val burn_storage_fees :
    context -> storage_limit:Z.t -> payer:Contract.t -> context tzresult Lwt.t

  type error += Cannot_pay_storage_fee (* `Temporary *)

  type error += Operation_quota_exceeded (* `Temporary *)

  type error += Storage_limit_too_high (* `Permanent *)

  val check_storage_limit : context -> storage_limit:Z.t -> unit tzresult
end

module Operation : sig
  type nonrec 'kind contents = 'kind contents

  type nonrec packed_contents = packed_contents

  val contents_encoding : packed_contents Data_encoding.t

  type nonrec 'kind protocol_data = 'kind protocol_data

  type nonrec packed_protocol_data = packed_protocol_data

  val protocol_data_encoding : packed_protocol_data Data_encoding.t

  val unsigned_encoding :
    (Operation.shell_header * packed_contents_list) Data_encoding.t

  type raw = Operation.t = {shell : Operation.shell_header; proto : MBytes.t}

  val raw_encoding : raw Data_encoding.t

  val contents_list_encoding : packed_contents_list Data_encoding.t

  type 'kind t = 'kind operation = {
    shell : Operation.shell_header;
    protocol_data : 'kind protocol_data;
  }

  type nonrec packed = packed_operation

  val encoding : packed Data_encoding.t

  val raw : _ operation -> raw

  val hash : _ operation -> Operation_hash.t

  val hash_raw : raw -> Operation_hash.t

  val hash_packed : packed_operation -> Operation_hash.t

  val acceptable_passes : packed_operation -> int list

  type error += Missing_signature (* `Permanent *)

  type error += Invalid_signature (* `Permanent *)

  val check_signature :
    public_key -> Chain_id.t -> _ operation -> unit tzresult Lwt.t

  val check_signature_sync :
    public_key -> Chain_id.t -> _ operation -> unit tzresult

  val internal_operation_encoding : packed_internal_operation Data_encoding.t

  val pack : 'kind operation -> packed_operation

  type ('a, 'b) eq = Eq : ('a, 'a) eq

  val equal : 'a operation -> 'b operation -> ('a, 'b) eq option

  module Encoding : sig
    type 'b case =
      | Case : {
          tag : int;
          name : string;
          encoding : 'a Data_encoding.t;
          select : packed_contents -> 'b contents option;
          proj : 'b contents -> 'a;
          inj : 'a -> 'b contents;
        }
          -> 'b case

    val endorsement_case : Kind.endorsement case

    val seed_nonce_revelation_case : Kind.seed_nonce_revelation case

    val double_endorsement_evidence_case :
      Kind.double_endorsement_evidence case

    val double_baking_evidence_case : Kind.double_baking_evidence case

    val activate_account_case : Kind.activate_account case

    val proposals_case : Kind.proposals case

    val ballot_case : Kind.ballot case

    val reveal_case : Kind.reveal Kind.manager case

    val transaction_case : Kind.transaction Kind.manager case

    val origination_case : Kind.origination Kind.manager case

    val delegation_case : Kind.delegation Kind.manager case

    module Manager_operations : sig
      type 'b case =
        | MCase : {
            tag : int;
            name : string;
            encoding : 'a Data_encoding.t;
            select :
              packed_manager_operation -> 'kind manager_operation option;
            proj : 'kind manager_operation -> 'a;
            inj : 'a -> 'kind manager_operation;
          }
            -> 'kind case

      val reveal_case : Kind.reveal case

      val transaction_case : Kind.transaction case

      val origination_case : Kind.origination case

      val delegation_case : Kind.delegation case
    end
  end

  val of_list : packed_contents list -> packed_contents_list

  val to_list : packed_contents_list -> packed_contents list
end

module Roll : sig
  type t = private int32

  type roll = t

  val encoding : roll Data_encoding.t

  val snapshot_rolls : context -> context tzresult Lwt.t

  val cycle_end : context -> Cycle.t -> context tzresult Lwt.t

  val baking_rights_owner :
    context -> Level.t -> priority:int -> public_key tzresult Lwt.t

  val endorsement_rights_owner :
    context -> Level.t -> slot:int -> public_key tzresult Lwt.t

  val delegate_pubkey : context -> public_key_hash -> public_key tzresult Lwt.t

  val get_rolls :
    context -> Signature.Public_key_hash.t -> roll list tzresult Lwt.t

  val get_change :
    context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t
end

module Commitment : sig
  type t = {
    blinded_public_key_hash : Blinded_public_key_hash.t;
    amount : Tez.tez;
  }

  val get_opt :
    context -> Blinded_public_key_hash.t -> Tez.t option tzresult Lwt.t

  val delete : context -> Blinded_public_key_hash.t -> context tzresult Lwt.t
end

module Bootstrap : sig
  val cycle_end : context -> Cycle.t -> context tzresult Lwt.t
end

module Global : sig
  val get_block_priority : context -> int tzresult Lwt.t

  val set_block_priority : context -> int -> context tzresult Lwt.t
end

val prepare_first_block :
  Context.t ->
  typecheck:(context ->
            Script.t ->
            ((Script.t * Contract.big_map_diff option) * context) tzresult
            Lwt.t) ->
  level:Int32.t ->
  timestamp:Time.t ->
  fitness:Fitness.t ->
  context tzresult Lwt.t

val prepare :
  Context.t ->
  level:Int32.t ->
  predecessor_timestamp:Time.t ->
  timestamp:Time.t ->
  fitness:Fitness.t ->
  context tzresult Lwt.t

val finalize : ?commit_message:string -> context -> Updater.validation_result

val activate : context -> Protocol_hash.t -> context Lwt.t

val fork_test_chain : context -> Protocol_hash.t -> Time.t -> context Lwt.t

val record_endorsement : context -> Signature.Public_key_hash.t -> context

val allowed_endorsements :
  context ->
  (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t

val init_endorsements :
  context ->
  (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t ->
  context

val included_endorsements : context -> int

val reset_internal_nonce : context -> context

val fresh_internal_nonce : context -> (context * int) tzresult

val record_internal_nonce : context -> int -> context

val internal_nonce_already_recorded : context -> int -> bool

val add_fees : context -> Tez.t -> context tzresult Lwt.t

val add_rewards : context -> Tez.t -> context tzresult Lwt.t

val add_deposit :
  context -> Signature.Public_key_hash.t -> Tez.t -> context tzresult Lwt.t

val get_fees : context -> Tez.t

val get_rewards : context -> Tez.t

val get_deposits : context -> Tez.t Signature.Public_key_hash.Map.t

val description : context Storage_description.t
alpha_context_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

module_type

Parameter t : Type.

Definition context := t.

Definition public_key :=
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t.

Definition public_key_hash :=
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t.

Definition signature :=
  Tezos_protocol_environment_alpha__Environment.Signature.t.

Module Tez.
  include
  
  Definition tez := t.
  
  Parameter zero : tez.
  
  Parameter one_mutez : tez.
  
  Parameter one_cent : tez.
  
  Parameter fifty_cents : tez.
  
  Parameter one : tez.
  
  Parameter op_minusquestion : tez ->
    tez ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult tez.
  
  Parameter op_plusquestion : tez ->
    tez ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult tez.
  
  Parameter op_starquestion : tez ->
    int64 ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult tez.
  
  Parameter op_divquestion : tez ->
    int64 ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult tez.
  
  Parameter of_string : string -> option tez.
  
  Parameter to_string : tez -> string.
  
  Parameter of_mutez : int64 -> option tez.
  
  Parameter to_mutez : tez -> int64.
End Tez.

Module Period.
  include
  
  Definition period := t.
  
  Parameter rpc_arg : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg
    period.
  
  Parameter of_seconds : int64 ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult period.
  
  Parameter to_seconds : period -> int64.
  
  Parameter mult : int32 ->
    period ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult period.
  
  Parameter zero : period.
  
  Parameter one_second : period.
  
  Parameter one_minute : period.
  
  Parameter one_hour : period.
End Period.

Module Timestamp.
  include
  
  Definition time := t.
  
  Parameter op_plusquestion : time ->
    Period.t ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult time.
  
  Parameter op_minusquestion : time ->
    time ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Period.t.
  
  Parameter of_notation : string -> option time.
  
  Parameter to_notation : time -> string.
  
  Parameter of_seconds : string -> option time.
  
  Parameter to_seconds_string : time -> string.
  
  Parameter current : context -> time.
End Timestamp.

Module Raw_level.
  include
  
  Definition raw_level := t.
  
  Parameter rpc_arg : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg
    raw_level.
  
  Parameter diff : raw_level -> raw_level -> int32.
  
  Parameter root : raw_level.
  
  Parameter succ : raw_level -> raw_level.
  
  Parameter pred : raw_level -> option raw_level.
  
  Parameter to_int32 : raw_level -> int32.
  
  Parameter of_int32 : int32 ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult raw_level.
End Raw_level.

Module Cycle.
  include
  
  Definition cycle := t.
  
  Parameter rpc_arg : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg
    cycle.
  
  Parameter root : cycle.
  
  Parameter succ : cycle -> cycle.
  
  Parameter pred : cycle -> option cycle.
  
  Parameter add : cycle -> Z -> cycle.
  
  Parameter sub : cycle -> Z -> option cycle.
  
  Parameter to_int32 : cycle -> int32.
  
  unhandled_module
End Cycle.

Module Gas.
  Inductive t : Type :=
  | Unaccounted : t
  | Limited : Tezos_protocol_environment_alpha__Environment.Z.t -> t.
  
  Parameter encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    t.
  
  Parameter pp : Tezos_protocol_environment_alpha__Environment.Format.formatter
    -> t -> unit.
  
  Parameter cost : Type.
  
  Parameter cost_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    cost.
  
  Parameter pp_cost : Tezos_protocol_environment_alpha__Environment.Format.formatter
    -> cost -> unit.
  
  extensible_type
  
  extensible_type
  
  extensible_type
  
  Parameter free : cost.
  
  Parameter atomic_step_cost : Z -> cost.
  
  Parameter step_cost : Z -> cost.
  
  Parameter alloc_cost : Z -> cost.
  
  Parameter alloc_bytes_cost : Z -> cost.
  
  Parameter alloc_mbytes_cost : Z -> cost.
  
  Parameter alloc_bits_cost : Z -> cost.
  
  Parameter read_bytes_cost : Tezos_protocol_environment_alpha__Environment.Z.t
    -> cost.
  
  Parameter write_bytes_cost : Tezos_protocol_environment_alpha__Environment.Z.t
    -> cost.
  
  Parameter op_starat : Z -> cost -> cost.
  
  Parameter op_plusat : cost -> cost -> cost.
  
  Parameter check_limit : context ->
    Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.
  
  Parameter set_limit : context ->
    Tezos_protocol_environment_alpha__Environment.Z.t -> context.
  
  Parameter set_unlimited : context -> context.
  
  Parameter consume : context ->
    cost ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult context.
  
  Parameter check_enough : context ->
    cost ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.
  
  Parameter level : context -> t.
  
  Parameter consumed : context ->
    context -> Tezos_protocol_environment_alpha__Environment.Z.t.
  
  Parameter block_level : context ->
    Tezos_protocol_environment_alpha__Environment.Z.t.
End Gas.

unhandled_module

Module Script_timestamp.
  Parameter t : Type.
  
  Parameter compare : t -> t -> Z.
  
  Parameter to_string : t -> string.
  
  Parameter to_notation : t -> option string.
  
  Parameter to_num_str : t -> string.
  
  Parameter of_string : string -> option t.
  
  Parameter diff : t -> t -> Script_int.num Script_int.z.
  
  Parameter add_delta : t -> Script_int.num Script_int.z -> t.
  
  Parameter sub_delta : t -> Script_int.num Script_int.z -> t.
  
  Parameter now : context -> t.
  
  Parameter to_zint : t -> Tezos_protocol_environment_alpha__Environment.Z.t.
  
  Parameter of_zint : Tezos_protocol_environment_alpha__Environment.Z.t -> t.
End Script_timestamp.

Module Script.
  Inductive prim : Type :=
  | K_parameter : prim
  | K_storage : prim
  | K_code : prim
  | D_False : prim
  | D_Elt : prim
  | D_Left : prim
  | D_None : prim
  | D_Pair : prim
  | D_Right : prim
  | D_Some : prim
  | D_True : prim
  | D_Unit : prim
  | I_PACK : prim
  | I_UNPACK : prim
  | I_BLAKE2B : prim
  | I_SHA256 : prim
  | I_SHA512 : prim
  | I_ABS : prim
  | I_ADD : prim
  | I_AMOUNT : prim
  | I_AND : prim
  | I_BALANCE : prim
  | I_CAR : prim
  | I_CDR : prim
  | I_CHAIN_ID : prim
  | I_CHECK_SIGNATURE : prim
  | I_COMPARE : prim
  | I_CONCAT : prim
  | I_CONS : prim
  | I_CREATE_ACCOUNT : prim
  | I_CREATE_CONTRACT : prim
  | I_IMPLICIT_ACCOUNT : prim
  | I_DIP : prim
  | I_DROP : prim
  | I_DUP : prim
  | I_EDIV : prim
  | I_EMPTY_BIG_MAP : prim
  | I_EMPTY_MAP : prim
  | I_EMPTY_SET : prim
  | I_EQ : prim
  | I_EXEC : prim
  | I_APPLY : prim
  | I_FAILWITH : prim
  | I_GE : prim
  | I_GET : prim
  | I_GT : prim
  | I_HASH_KEY : prim
  | I_IF : prim
  | I_IF_CONS : prim
  | I_IF_LEFT : prim
  | I_IF_NONE : prim
  | I_INT : prim
  | I_LAMBDA : prim
  | I_LE : prim
  | I_LEFT : prim
  | I_LOOP : prim
  | I_LSL : prim
  | I_LSR : prim
  | I_LT : prim
  | I_MAP : prim
  | I_MEM : prim
  | I_MUL : prim
  | I_NEG : prim
  | I_NEQ : prim
  | I_NIL : prim
  | I_NONE : prim
  | I_NOT : prim
  | I_NOW : prim
  | I_OR : prim
  | I_PAIR : prim
  | I_PUSH : prim
  | I_RIGHT : prim
  | I_SIZE : prim
  | I_SOME : prim
  | I_SOURCE : prim
  | I_SENDER : prim
  | I_SELF : prim
  | I_SLICE : prim
  | I_STEPS_TO_QUOTA : prim
  | I_SUB : prim
  | I_SWAP : prim
  | I_TRANSFER_TOKENS : prim
  | I_SET_DELEGATE : prim
  | I_UNIT : prim
  | I_UPDATE : prim
  | I_XOR : prim
  | I_ITER : prim
  | I_LOOP_LEFT : prim
  | I_ADDRESS : prim
  | I_CONTRACT : prim
  | I_ISNAT : prim
  | I_CAST : prim
  | I_RENAME : prim
  | I_DIG : prim
  | I_DUG : prim
  | T_bool : prim
  | T_contract : prim
  | T_int : prim
  | T_key : prim
  | T_key_hash : prim
  | T_lambda : prim
  | T_list : prim
  | T_map : prim
  | T_big_map : prim
  | T_nat : prim
  | T_option : prim
  | T_or : prim
  | T_pair : prim
  | T_set : prim
  | T_signature : prim
  | T_string : prim
  | T_bytes : prim
  | T_mutez : prim
  | T_timestamp : prim
  | T_unit : prim
  | T_operation : prim
  | T_address : prim
  | T_chain_id : prim.
  
  Definition location :=
    Tezos_protocol_environment_alpha__Environment.Micheline.canonical_location.
  
  Definition annot :=
    Tezos_protocol_environment_alpha__Environment.Micheline.annot.
  
  Definition expr :=
    Tezos_protocol_environment_alpha__Environment.Micheline.canonical prim.
  
  Definition lazy_expr :=
    Tezos_protocol_environment_alpha__Environment.Data_encoding.lazy_t expr.
  
  Parameter lazy_expr : expr -> lazy_expr.
  
  Definition node :=
    Tezos_protocol_environment_alpha__Environment.Micheline.node location prim.
  
  Record t := {
    code : lazy_expr;
    storage : lazy_expr }.
  
  Parameter location_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    location.
  
  Parameter expr_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    expr.
  
  Parameter prim_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    prim.
  
  Parameter encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    t.
  
  Parameter lazy_expr_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    lazy_expr.
  
  Parameter deserialized_cost : expr -> Gas.cost.
  
  Parameter serialized_cost : Tezos_protocol_environment_alpha__Environment.MBytes.t
    -> Gas.cost.
  
  Parameter traversal_cost : node -> Gas.cost.
  
  Parameter node_cost : node -> Gas.cost.
  
  Parameter int_node_cost : Tezos_protocol_environment_alpha__Environment.Z.t ->
    Gas.cost.
  
  Parameter int_node_cost_of_numbits : Z -> Gas.cost.
  
  Parameter string_node_cost : string -> Gas.cost.
  
  Parameter string_node_cost_of_length : Z -> Gas.cost.
  
  Parameter bytes_node_cost : Tezos_protocol_environment_alpha__Environment.MBytes.t
    -> Gas.cost.
  
  Parameter bytes_node_cost_of_length : Z -> Gas.cost.
  
  Parameter prim_node_cost_nonrec : list expr -> annot -> Gas.cost.
  
  Parameter prim_node_cost_nonrec_of_length : Z -> annot -> Gas.cost.
  
  Parameter seq_node_cost_nonrec : list expr -> Gas.cost.
  
  Parameter seq_node_cost_nonrec_of_length : Z -> Gas.cost.
  
  Parameter minimal_deserialize_cost : lazy_expr -> Gas.cost.
  
  Parameter force_decode : context ->
    lazy_expr ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (expr * context)).
  
  Parameter force_bytes : context ->
    lazy_expr ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_protocol_environment_alpha__Environment.MBytes.t * context)).
  
  Parameter unit_parameter : lazy_expr.
  
  Module Legacy_support.
    Parameter manager_script_code : lazy_expr.
    
    Parameter add_do : Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
      ->
      lazy_expr ->
        lazy_expr ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (lazy_expr * lazy_expr)).
    
    Parameter add_set_delegate : Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
      ->
      lazy_expr ->
        lazy_expr ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (lazy_expr * lazy_expr)).
    
    Parameter has_default_entrypoint : lazy_expr -> bool.
    
    Parameter add_root_entrypoint : lazy_expr ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          lazy_expr).
  End Legacy_support.
End Script.

Module Constants.
  Record fixed := {
    proof_of_work_nonce_size : Z;
    nonce_length : Z;
    max_revelations_per_block : Z;
    max_operation_data_length : Z;
    max_proposals_per_delegate : Z }.
  
  Parameter fixed_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    fixed.
  
  Parameter fixed : fixed.
  
  Parameter proof_of_work_nonce_size : Z.
  
  Parameter nonce_length : Z.
  
  Parameter max_revelations_per_block : Z.
  
  Parameter max_operation_data_length : Z.
  
  Parameter max_proposals_per_delegate : Z.
  
  Record parametric := {
    preserved_cycles : Z;
    blocks_per_cycle : int32;
    blocks_per_commitment : int32;
    blocks_per_roll_snapshot : int32;
    blocks_per_voting_period : int32;
    time_between_blocks : list Period.t;
    endorsers_per_block : Z;
    hard_gas_limit_per_operation :
      Tezos_protocol_environment_alpha__Environment.Z.t;
    hard_gas_limit_per_block : Tezos_protocol_environment_alpha__Environment.Z.t;
    proof_of_work_threshold : int64;
    tokens_per_roll : Tez.t;
    michelson_maximum_type_size : Z;
    seed_nonce_revelation_tip : Tez.t;
    origination_size : Z;
    block_security_deposit : Tez.t;
    endorsement_security_deposit : Tez.t;
    block_reward : Tez.t;
    endorsement_reward : Tez.t;
    cost_per_byte : Tez.t;
    hard_storage_limit_per_operation :
      Tezos_protocol_environment_alpha__Environment.Z.t;
    test_chain_duration : int64;
    quorum_min : int32;
    quorum_max : int32;
    min_proposal_quorum : int32;
    initial_endorsers : Z;
    delay_per_missing_endorsement : Period.t }.
  
  Parameter parametric_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    parametric.
  
  Parameter parametric : context -> parametric.
  
  Parameter preserved_cycles : context -> Z.
  
  Parameter blocks_per_cycle : context -> int32.
  
  Parameter blocks_per_commitment : context -> int32.
  
  Parameter blocks_per_roll_snapshot : context -> int32.
  
  Parameter blocks_per_voting_period : context -> int32.
  
  Parameter time_between_blocks : context -> list Period.t.
  
  Parameter endorsers_per_block : context -> Z.
  
  Parameter initial_endorsers : context -> Z.
  
  Parameter delay_per_missing_endorsement : context -> Period.t.
  
  Parameter hard_gas_limit_per_operation : context ->
    Tezos_protocol_environment_alpha__Environment.Z.t.
  
  Parameter hard_gas_limit_per_block : context ->
    Tezos_protocol_environment_alpha__Environment.Z.t.
  
  Parameter cost_per_byte : context -> Tez.t.
  
  Parameter hard_storage_limit_per_operation : context ->
    Tezos_protocol_environment_alpha__Environment.Z.t.
  
  Parameter proof_of_work_threshold : context -> int64.
  
  Parameter tokens_per_roll : context -> Tez.t.
  
  Parameter michelson_maximum_type_size : context -> Z.
  
  Parameter block_reward : context -> Tez.t.
  
  Parameter endorsement_reward : context -> Tez.t.
  
  Parameter seed_nonce_revelation_tip : context -> Tez.t.
  
  Parameter origination_size : context -> Z.
  
  Parameter block_security_deposit : context -> Tez.t.
  
  Parameter endorsement_security_deposit : context -> Tez.t.
  
  Parameter test_chain_duration : context -> int64.
  
  Parameter quorum_min : context -> int32.
  
  Parameter quorum_max : context -> int32.
  
  Parameter min_proposal_quorum : context -> int32.
  
  Record t := {
    fixed : fixed;
    parametric : parametric }.
  
  Parameter encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    t.
End Constants.

Module Voting_period.
  include
  
  Definition voting_period := t.
  
  Parameter rpc_arg : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg
    voting_period.
  
  Parameter root : voting_period.
  
  Parameter succ : voting_period -> voting_period.
  
  Inductive kind : Type :=
  | Proposal : kind
  | Testing_vote : kind
  | Testing : kind
  | Promotion_vote : kind.
  
  Parameter kind_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    kind.
  
  Parameter to_int32 : voting_period -> int32.
End Voting_period.

Module Level.
  Record t := {
    level : Raw_level.t;
    level_position : int32;
    cycle : Cycle.t;
    cycle_position : int32;
    voting_period : Voting_period.t;
    voting_period_position : int32;
    expected_commitment : bool }.
  
  include
  
  Parameter pp_full : Tezos_protocol_environment_alpha__Environment.Format.formatter
    -> t -> unit.
  
  Definition level := t.
  
  Parameter root : context -> level.
  
  Parameter succ : context -> level -> level.
  
  Parameter pred : context -> level -> option level.
  
  Parameter from_raw : context -> option int32 -> Raw_level.t -> level.
  
  Parameter diff : level -> level -> int32.
  
  Parameter current : context -> level.
  
  Parameter last_level_in_cycle : context -> Cycle.t -> level.
  
  Parameter levels_in_cycle : context -> Cycle.t -> list level.
  
  Parameter levels_in_current_cycle : context ->
    option int32 -> unit -> list level.
  
  Parameter last_allowed_fork_level : context -> Raw_level.t.
End Level.

Module Fitness.
  include
  
  Definition fitness := t.
  
  Parameter increase : option Z -> context -> context.
  
  Parameter current : context -> int64.
  
  Parameter to_int64 : fitness ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int64.
End Fitness.

Module Nonce.
  Parameter t : Type.
  
  Definition nonce := t.
  
  Parameter encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    nonce.
  
  Record unrevealed := {
    nonce_hash : Tezos_raw_protocol_alpha.Nonce_hash.t;
    delegate : public_key_hash;
    rewards : Tez.t;
    fees : Tez.t }.
  
  Parameter record_hash : context ->
    unrevealed ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          context).
  
  Parameter reveal : context ->
    Level.t ->
      nonce ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            context).
  
  Inductive status : Type :=
  | Unrevealed : unrevealed -> status
  | Revealed : nonce -> status.
  
  Parameter get : context ->
    Level.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          status).
  
  Parameter of_bytes : Tezos_protocol_environment_alpha__Environment.MBytes.t ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult nonce.
  
  Parameter hash : nonce -> Tezos_raw_protocol_alpha.Nonce_hash.t.
  
  Parameter check_hash : nonce -> Tezos_raw_protocol_alpha.Nonce_hash.t -> bool.
End Nonce.

Module Seed.
  Parameter seed : Type.
  
  extensible_type
  
  Parameter for_cycle : context ->
    Cycle.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult seed).
  
  Parameter cycle_end : context ->
    Cycle.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (context * list Nonce.unrevealed)).
  
  Parameter seed_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    seed.
End Seed.

Module Big_map.
  Definition id := Tezos_protocol_environment_alpha__Environment.Z.t.
  
  Parameter fresh : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (context * id)).
  
  Parameter fresh_temporary : context -> context * id.
  
  Parameter mem : context ->
    id ->
      Tezos_raw_protocol_alpha.Script_expr_hash.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (context * bool)).
  
  Parameter get_opt : context ->
    id ->
      Tezos_raw_protocol_alpha.Script_expr_hash.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (context * option Script.expr)).
  
  Parameter rpc_arg : Tezos_protocol_environment_alpha__Environment.RPC_arg.t id.
  
  Parameter cleanup_temporary : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t context.
  
  Parameter __exists : context ->
    id ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (context * option (Script.expr * Script.expr))).
End Big_map.

Module Contract.
  include
  
  Definition contract := t.
  
  Parameter rpc_arg : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg
    contract.
  
  Parameter to_b58check : contract -> string.
  
  Parameter of_b58check : string ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult contract.
  
  Parameter implicit_contract : public_key_hash -> contract.
  
  Parameter is_implicit : contract -> option public_key_hash.
  
  Parameter __exists : context ->
    contract ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).
  
  Parameter must_exist : context ->
    contract ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).
  
  Parameter allocated : context ->
    contract ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).
  
  Parameter must_be_allocated : context ->
    contract ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).
  
  Parameter list : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t (list contract).
  
  Parameter get_manager_key : context ->
    public_key_hash ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          public_key).
  
  Parameter is_manager_key_revealed : context ->
    public_key_hash ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).
  
  Parameter reveal_manager_key : context ->
    public_key_hash ->
      public_key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            context).
  
  Parameter get_script_code : context ->
    contract ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (context * option Script.lazy_expr)).
  
  Parameter get_script : context ->
    contract ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (context * option Script.t)).
  
  Parameter get_storage : context ->
    contract ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (context * option Script.expr)).
  
  Parameter get_counter : context ->
    public_key_hash ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_protocol_environment_alpha__Environment.Z.t).
  
  Parameter get_balance : context ->
    contract ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tez.t).
  
  Parameter init_origination_nonce : context ->
    Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
      -> context.
  
  Parameter unset_origination_nonce : context -> context.
  
  Parameter fresh_contract_from_current_nonce : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (context * t)).
  
  Parameter originated_from_current_nonce : context ->
    context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (list contract)).
  
  Inductive big_map_diff_item : Type :=
  | Update : Big_map.id -> Script.expr ->
    Tezos_raw_protocol_alpha.Script_expr_hash.t -> option Script.expr ->
    big_map_diff_item
  | Clear : Big_map.id -> big_map_diff_item
  | Copy : Big_map.id -> Big_map.id -> big_map_diff_item
  | Alloc : Big_map.id -> Script.expr -> Script.expr -> big_map_diff_item.
  
  Definition big_map_diff := list big_map_diff_item.
  
  Parameter big_map_diff_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    big_map_diff.
  
  Parameter originate : context ->
    contract ->
      Tez.t ->
        Script.t * option big_map_diff ->
          option public_key_hash ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                context).
  
  extensible_type
  
  Parameter spend : context ->
    contract ->
      Tez.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            context).
  
  Parameter credit : context ->
    contract ->
      Tez.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            context).
  
  Parameter update_script_storage : context ->
    contract ->
      Script.expr ->
        option big_map_diff ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              context).
  
  Parameter used_storage_space : context ->
    t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_protocol_environment_alpha__Environment.Z.t).
  
  Parameter increment_counter : context ->
    public_key_hash ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          context).
  
  Parameter check_counter_increment : context ->
    public_key_hash ->
      Tezos_protocol_environment_alpha__Environment.Z.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            unit).
  
  Parameter origination_nonce : Type.
  
  Parameter initial_origination_nonce : Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
    -> origination_nonce.
  
  Parameter originated_contract : origination_nonce -> contract.
End Contract.

Module Delegate.
  Inductive balance : Type :=
  | Contract : Contract.t -> balance
  | Rewards :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Cycle.t -> balance
  | Fees :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Cycle.t -> balance
  | Deposits :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Cycle.t -> balance.
  
  Inductive balance_update : Type :=
  | Debited : Tez.t -> balance_update
  | Credited : Tez.t -> balance_update.
  
  Definition balance_updates := list (balance * balance_update).
  
  Parameter balance_updates_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    balance_updates.
  
  Parameter cleanup_balance_updates : balance_updates -> balance_updates.
  
  Parameter get : context ->
    Contract.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option public_key_hash)).
  
  Parameter set : context ->
    Contract.t ->
      option public_key_hash ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            context).
  
  Parameter fold : forall {a : Type}, context ->
    a ->
      (public_key_hash ->
        a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  
  Parameter list : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t (list public_key_hash).
  
  Parameter freeze_deposit : context ->
    public_key_hash ->
      Tez.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            context).
  
  Parameter freeze_rewards : context ->
    public_key_hash ->
      Tez.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            context).
  
  Parameter freeze_fees : context ->
    public_key_hash ->
      Tez.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            context).
  
  Parameter cycle_end : context ->
    Cycle.t ->
      list Nonce.unrevealed ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (context * balance_updates *
              list
                Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)).
  
  Record frozen_balance := {
    deposit : Tez.t;
    fees : Tez.t;
    rewards : Tez.t }.
  
  Parameter punish : context ->
    public_key_hash ->
      Cycle.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (context * frozen_balance)).
  
  Parameter full_balance : context ->
    public_key_hash ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tez.t).
  
  Parameter has_frozen_balance : context ->
    public_key_hash ->
      Cycle.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            bool).
  
  Parameter frozen_balance : context ->
    public_key_hash ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tez.t).
  
  Parameter frozen_balance_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    frozen_balance.
  
  Parameter frozen_balance_by_cycle_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    (Cycle.Map.(Tezos_protocol_environment_alpha__Environment.MAP.S.t)
      frozen_balance).
  
  Parameter frozen_balance_by_cycle : context ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Cycle.Map.(Tezos_protocol_environment_alpha__Environment.MAP.S.t)
          frozen_balance).
  
  Parameter staking_balance : context ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tez.t).
  
  Parameter delegated_contracts : context ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (list Tezos_raw_protocol_alpha.Contract_repr.t).
  
  Parameter delegated_balance : context ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tez.t).
  
  Parameter deactivated : context ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).
  
  Parameter grace_period : context ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Cycle.t).
End Delegate.

Module Vote.
  Definition proposal :=
    Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t).
  
  Parameter record_proposal : context ->
    Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
      ->
      public_key_hash ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            context).
  
  Parameter get_proposals : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_protocol_environment_alpha__Environment.Protocol_hash.Map.t int32)).
  
  Parameter clear_proposals : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t context.
  
  Parameter recorded_proposal_count_for_delegate : context ->
    public_key_hash ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z).
  
  Parameter listings_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    (list
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
        * int32)).
  
  Parameter freeze_listings : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter clear_listings : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter listing_size : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int32).
  
  Parameter in_listings : context ->
    public_key_hash -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
  
  Parameter get_listings : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (list (public_key_hash * int32)).
  
  Inductive ballot : Type :=
  | Yay : ballot
  | Nay : ballot
  | Pass : ballot.
  
  Parameter ballot_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    ballot.
  
  Record ballots := {
    yay : int32;
    nay : int32;
    pass : int32 }.
  
  Parameter ballots_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    ballots.
  
  Parameter has_recorded_ballot : context ->
    public_key_hash -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool.
  
  Parameter record_ballot : context ->
    public_key_hash ->
      ballot ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            context).
  
  Parameter get_ballots : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        ballots).
  
  Parameter get_ballot_list : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (list
        (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
          * ballot)).
  
  Parameter clear_ballots : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t context.
  
  Parameter get_current_period_kind : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Voting_period.kind).
  
  Parameter set_current_period_kind : context ->
    Voting_period.kind ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          context).
  
  Parameter get_current_quorum : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int32).
  
  Parameter get_participation_ema : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int32).
  
  Parameter set_participation_ema : context ->
    int32 ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          context).
  
  Parameter get_current_proposal : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        proposal).
  
  Parameter init_current_proposal : context ->
    proposal ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          context).
  
  Parameter clear_current_proposal : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
End Vote.

Module Block_header.
  Reserved Notation "'t".
  Reserved Notation "'protocol_data".
  Reserved Notation "'contents".
  
  Record contents_skeleton {priority seed_nonce_hash proof_of_work_nonce : Type}
    := {
    priority : priority;
    seed_nonce_hash : seed_nonce_hash;
    proof_of_work_nonce : proof_of_work_nonce }.
  Arguments contents_skeleton : clear implicits.
  
  Record protocol_data_skeleton {contents signature : Type} := {
    contents : contents;
    signature : signature }.
  Arguments protocol_data_skeleton : clear implicits.
  
  Record t_skeleton {shell protocol_data : Type} := {
    shell : shell;
    protocol_data : protocol_data }.
  Arguments t_skeleton : clear implicits.
  
  
  
  where "'t" :=
    (t_skeleton
      Tezos_protocol_environment_alpha__Environment.Block_header.shell_header
      'protocol_data)
  and "'protocol_data" :=
    (protocol_data_skeleton 'contents
      Tezos_protocol_environment_alpha__Environment.Signature.t)
  and "'contents" :=
    (contents_skeleton Z (option Tezos_raw_protocol_alpha.Nonce_hash.t)
      Tezos_protocol_environment_alpha__Environment.MBytes.t).
  
  Definition t := 't.
  Definition protocol_data := 'protocol_data.
  Definition contents := 'contents.
  
  Definition block_header := t.
  
  Definition raw :=
    Tezos_protocol_environment_alpha__Environment.Block_header.t.
  
  Definition shell_header :=
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.
  
  Parameter raw : block_header -> raw.
  
  Parameter hash : block_header ->
    Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t).
  
  Parameter hash_raw : raw ->
    Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t).
  
  Parameter encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    block_header.
  
  Parameter raw_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    raw.
  
  Parameter contents_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    contents.
  
  Parameter unsigned_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    (shell_header * contents).
  
  Parameter protocol_data_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    protocol_data.
  
  Parameter shell_header_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    shell_header.
  
  Parameter max_header_length : Z.
End Block_header.

Module Kind.
  Inductive seed_nonce_revelation : Type :=
  | Seed_nonce_revelation_kind : seed_nonce_revelation.
  
  Inductive double_endorsement_evidence : Type :=
  | Double_endorsement_evidence_kind : double_endorsement_evidence.
  
  Inductive double_baking_evidence : Type :=
  | Double_baking_evidence_kind : double_baking_evidence.
  
  Inductive activate_account : Type :=
  | Activate_account_kind : activate_account.
  
  Inductive endorsement : Type :=
  | Endorsement_kind : endorsement.
  
  Inductive proposals : Type :=
  | Proposals_kind : proposals.
  
  Inductive ballot : Type :=
  | Ballot_kind : ballot.
  
  Inductive reveal : Type :=
  | Reveal_kind : reveal.
  
  Inductive transaction : Type :=
  | Transaction_kind : transaction.
  
  Inductive origination : Type :=
  | Origination_kind : origination.
  
  Inductive delegation : Type :=
  | Delegation_kind : delegation.
  
  Reserved Notation "'manager".
  
  Inductive manager_gadt : Type :=
  | Reveal_manager_kind : manager_gadt
  | Transaction_manager_kind : manager_gadt
  | Origination_manager_kind : manager_gadt
  | Delegation_manager_kind : manager_gadt
  
  where "'manager" := (fun (a : Type) => manager_gadt).
  
  Definition manager := 'manager.
End Kind.

Reserved Notation "'operation".
Reserved Notation "'protocol_data".
Reserved Notation "'contents_list".
Reserved Notation "'contents".
Reserved Notation "'manager_operation".
Reserved Notation "'counter".

Record protocol_data_skeleton {contents signature : Type} := {
  contents : contents;
  signature : signature }.
Arguments protocol_data_skeleton : clear implicits.

Record operation_skeleton {shell protocol_data : Type} := {
  shell : shell;
  protocol_data : protocol_data }.
Arguments operation_skeleton : clear implicits.

Inductive contents_list_gadt : Type :=
| Single : forall {kind : Type}, 'contents kind -> contents_list_gadt
| Cons : forall {kind : Type}, 'contents (Kind.manager kind) ->
  contents_list_gadt -> contents_list_gadt

with contents_gadt : Type :=
| Endorsement : Raw_level.t -> contents_gadt
| Seed_nonce_revelation : Raw_level.t -> Nonce.t -> contents_gadt
| Double_endorsement_evidence : 'operation Kind.endorsement ->
  'operation Kind.endorsement -> contents_gadt
| Double_baking_evidence : Block_header.t -> Block_header.t -> contents_gadt
| Activate_account :
  Tezos_protocol_environment_alpha__Environment.Ed25519.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Blinded_public_key_hash.activation_code ->
  contents_gadt
| Proposals :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Voting_period.t ->
  list
    Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
  -> contents_gadt
| Ballot :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Voting_period.t ->
  Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
  -> Vote.ballot -> contents_gadt
| Manager_operation : forall {kind : Type},
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tez.tez -> 'counter -> 'manager_operation kind ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t -> contents_gadt

with manager_operation_gadt : Type :=
| Reveal : Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t
  -> manager_operation_gadt
| Transaction : Tez.tez -> Script.lazy_expr -> string -> Contract.contract ->
  manager_operation_gadt
| Origination :
  option
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Script.t -> Tez.tez -> option Contract.t -> manager_operation_gadt
| Delegation :
  option
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  manager_operation_gadt

where "'operation" := (fun (kind : Type) =>
  operation_skeleton
    Tezos_protocol_environment_alpha__Environment.Operation.shell_header
    ('protocol_data kind))
and "'protocol_data" := (fun (kind : Type) =>
  protocol_data_skeleton ('contents_list kind)
    (option Tezos_protocol_environment_alpha__Environment.Signature.t))
and "'contents_list" := (fun (_ : Type) => contents_list_gadt)
and "'contents" := (fun (_ : Type) => contents_gadt)
and "'manager_operation" := (fun (_ : Type) => manager_operation_gadt)
and "'counter" := (Tezos_protocol_environment_alpha__Environment.Z.t).

Definition operation := 'operation.
Definition protocol_data := 'protocol_data.
Definition contents_list := 'contents_list.
Definition contents := 'contents.
Definition manager_operation := 'manager_operation.
Definition counter := 'counter.

Record internal_operation {kind : Type} := {
  source : Contract.contract;
  operation : manager_operation kind;
  nonce : Z }.
Arguments internal_operation : clear implicits.

Reserved Notation "'packed_manager_operation".

Inductive packed_manager_operation_gadt : Type :=
| Manager : forall {kind : Type}, manager_operation kind ->
  packed_manager_operation_gadt

where "'packed_manager_operation" := (packed_manager_operation_gadt).

Definition packed_manager_operation := 'packed_manager_operation.

Reserved Notation "'packed_contents".

Inductive packed_contents_gadt : Type :=
| Contents : forall {kind : Type}, contents kind -> packed_contents_gadt

where "'packed_contents" := (packed_contents_gadt).

Definition packed_contents := 'packed_contents.

Reserved Notation "'packed_contents_list".

Inductive packed_contents_list_gadt : Type :=
| Contents_list : forall {kind : Type}, contents_list kind ->
  packed_contents_list_gadt

where "'packed_contents_list" := (packed_contents_list_gadt).

Definition packed_contents_list := 'packed_contents_list.

Reserved Notation "'packed_protocol_data".

Inductive packed_protocol_data_gadt : Type :=
| Operation_data : forall {kind : Type}, protocol_data kind ->
  packed_protocol_data_gadt

where "'packed_protocol_data" := (packed_protocol_data_gadt).

Definition packed_protocol_data := 'packed_protocol_data.

Record packed_operation := {
  shell : Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
  protocol_data : packed_protocol_data }.

Reserved Notation "'packed_internal_operation".

Inductive packed_internal_operation_gadt : Type :=
| Internal_operation : forall {kind : Type}, internal_operation kind ->
  packed_internal_operation_gadt

where "'packed_internal_operation" := (packed_internal_operation_gadt).

Definition packed_internal_operation := 'packed_internal_operation.

Parameter manager_kind : forall {kind : Type},
manager_operation kind -> Kind.manager kind.

Module Fees.
  Parameter origination_burn : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (context * Tez.t)).
  
  Parameter record_paid_storage_space : context ->
    Contract.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (context * Tezos_protocol_environment_alpha__Environment.Z.t *
            Tezos_protocol_environment_alpha__Environment.Z.t * Tez.t)).
  
  Parameter start_counting_storage_fees : context -> context.
  
  Parameter burn_storage_fees : context ->
    Tezos_protocol_environment_alpha__Environment.Z.t ->
      Contract.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            context).
  
  extensible_type
  
  extensible_type
  
  extensible_type
  
  Parameter check_storage_limit : context ->
    Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.
End Fees.

Module Operation.
  Definition contents (kind : Type) := contents kind.
  
  Definition packed_contents := packed_contents.
  
  Parameter contents_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    packed_contents.
  
  Definition protocol_data (kind : Type) := protocol_data kind.
  
  Definition packed_protocol_data := packed_protocol_data.
  
  Parameter protocol_data_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    packed_protocol_data.
  
  Parameter unsigned_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    (Tezos_protocol_environment_alpha__Environment.Operation.shell_header *
      packed_contents_list).
  
  Record raw := {
    shell : Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
    proto : Tezos_protocol_environment_alpha__Environment.MBytes.t }.
  
  Parameter raw_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    raw.
  
  Parameter contents_list_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    packed_contents_list.
  
  Record t {kind : Type} := {
    shell : Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
    protocol_data : protocol_data kind }.
  Arguments t : clear implicits.
  
  Definition packed := packed_operation.
  
  Parameter encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    packed.
  
  Parameter raw : forall {_ : Type}, operation _ -> raw.
  
  Parameter hash : forall {_ : Type}, operation _ ->
    Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t).
  
  Parameter hash_raw : raw ->
    Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t).
  
  Parameter hash_packed : packed_operation ->
    Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t).
  
  Parameter acceptable_passes : packed_operation -> list Z.
  
  extensible_type
  
  extensible_type
  
  Parameter check_signature : forall {_ : Type}, public_key ->
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
      ->
      operation _ ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            unit).
  
  Parameter check_signature_sync : forall {_ : Type}, public_key ->
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
      ->
      operation _ ->
        Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.
  
  Parameter internal_operation_encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    packed_internal_operation.
  
  Parameter pack : forall {kind : Type}, operation kind -> packed_operation.
  
  Reserved Notation "'eq".
  
  Inductive eq_gadt : Type :=
  | Eq : eq_gadt
  
  where "'eq" := (fun (a b : Type) => eq_gadt).
  
  Definition eq := 'eq.
  
  Parameter equal : forall {a b : Type}, operation a ->
    operation b -> option (eq a b).
  
  Module Encoding.
    Reserved Notation "'case".
    
    Inductive case_gadt : Type :=
    | Case : forall {a b : Type}, Z -> string ->
      Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
      (packed_contents -> option (contents b)) -> (contents b -> a) ->
      (a -> contents b) -> case_gadt
    
    where "'case" := (fun (b : Type) => case_gadt).
    
    Definition case := 'case.
    
    Parameter endorsement_case : case Kind.endorsement.
    
    Parameter seed_nonce_revelation_case : case Kind.seed_nonce_revelation.
    
    Parameter double_endorsement_evidence_case : case
      Kind.double_endorsement_evidence.
    
    Parameter double_baking_evidence_case : case Kind.double_baking_evidence.
    
    Parameter activate_account_case : case Kind.activate_account.
    
    Parameter proposals_case : case Kind.proposals.
    
    Parameter ballot_case : case Kind.ballot.
    
    Parameter reveal_case : case (Kind.manager Kind.reveal).
    
    Parameter transaction_case : case (Kind.manager Kind.transaction).
    
    Parameter origination_case : case (Kind.manager Kind.origination).
    
    Parameter delegation_case : case (Kind.manager Kind.delegation).
    
    Module Manager_operations.
      Reserved Notation "'case".
      
      Inductive case_gadt : Type :=
      | MCase : forall {a kind : Type}, Z -> string ->
        Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
        (packed_manager_operation -> option (manager_operation kind)) ->
        (manager_operation kind -> a) -> (a -> manager_operation kind) ->
        case_gadt
      
      where "'case" := (fun (b : Type) => case_gadt).
      
      Definition case := 'case.
      
      Parameter reveal_case : case Kind.reveal.
      
      Parameter transaction_case : case Kind.transaction.
      
      Parameter origination_case : case Kind.origination.
      
      Parameter delegation_case : case Kind.delegation.
    End Manager_operations.
  End Encoding.
  
  Parameter of_list : list packed_contents -> packed_contents_list.
  
  Parameter to_list : packed_contents_list -> list packed_contents.
End Operation.

Module Roll.
  Definition t := int32.
  
  Definition roll := t.
  
  Parameter encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    roll.
  
  Parameter snapshot_rolls : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).
  
  Parameter cycle_end : context ->
    Cycle.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          context).
  
  Parameter baking_rights_owner : context ->
    Level.t ->
      Z ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            public_key).
  
  Parameter endorsement_rights_owner : context ->
    Level.t ->
      Z ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            public_key).
  
  Parameter delegate_pubkey : context ->
    public_key_hash ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          public_key).
  
  Parameter get_rolls : context ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (list roll)).
  
  Parameter get_change : context ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tez.t).
End Roll.

Module Commitment.
  Record t := {
    blinded_public_key_hash : Tezos_raw_protocol_alpha.Blinded_public_key_hash.t;
    amount : Tez.tez }.
  
  Parameter get_opt : context ->
    Tezos_raw_protocol_alpha.Blinded_public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option Tez.t)).
  
  Parameter delete : context ->
    Tezos_raw_protocol_alpha.Blinded_public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          context).
End Commitment.

Module Bootstrap.
  Parameter cycle_end : context ->
    Cycle.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          context).
End Bootstrap.

Module Global.
  Parameter get_block_priority : context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z).
  
  Parameter set_block_priority : context ->
    Z ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          context).
End Global.

Parameter prepare_first_block :
Tezos_protocol_environment_alpha__Environment.Context.t ->
  (context ->
    Script.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          ((Script.t * option Contract.big_map_diff) * context))) ->
    Tezos_protocol_environment_alpha__Environment.Int32.t ->
      Tezos_protocol_environment_alpha__Environment.Time.t ->
        Fitness.t ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              context).

Parameter prepare :
Tezos_protocol_environment_alpha__Environment.Context.t ->
  Tezos_protocol_environment_alpha__Environment.Int32.t ->
    Tezos_protocol_environment_alpha__Environment.Time.t ->
      Tezos_protocol_environment_alpha__Environment.Time.t ->
        Fitness.t ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              context).

Parameter finalize :
option string ->
  context ->
    Tezos_protocol_environment_alpha__Environment.Updater.validation_result.

Parameter activate :
context ->
  Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
    -> Tezos_protocol_environment_alpha__Environment.Lwt.t context.

Parameter fork_test_chain :
context ->
  Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
    ->
    Tezos_protocol_environment_alpha__Environment.Time.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t context.

Parameter record_endorsement :
context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    context.

Parameter allowed_endorsements :
context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
    (Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
      list Z * bool).

Parameter init_endorsements :
context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
    (Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
      list Z * bool) -> context.

Parameter included_endorsements : context -> Z.

Parameter reset_internal_nonce : context -> context.

Parameter fresh_internal_nonce :
context ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (context * Z).

Parameter record_internal_nonce : context -> Z -> context.

Parameter internal_nonce_already_recorded : context -> Z -> bool.

Parameter add_fees :
context ->
  Tez.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).

Parameter add_rewards :
context ->
  Tez.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).

Parameter add_deposit :
context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tez.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          context).

Parameter get_fees : context -> Tez.t.

Parameter get_rewards : context -> Tez.t.

Parameter get_deposits :
context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
    Tez.t.

Parameter description : Tezos_raw_protocol_alpha.Storage_description.t context.
alpha_services.ml 35 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

let custom_root = RPC_path.open_root

module Seed = struct
  module S = struct
    open Data_encoding

    let seed =
      RPC_service.post_service
        ~description:"Seed of the cycle to which the block belongs."
        ~query:RPC_query.empty
        ~input:empty
        ~output:Seed.seed_encoding
        RPC_path.(custom_root / "context" / "seed")
  end

  let () =
    let open Services_registration in
    register0 S.seed (fun ctxt () () ->
        let l = Level.current ctxt in
        Seed.for_cycle ctxt l.cycle)

  let get ctxt block = RPC_context.make_call0 S.seed ctxt block () ()
end

module Nonce = struct
  type info = Revealed of Nonce.t | Missing of Nonce_hash.t | Forgotten

  let info_encoding =
    let open Data_encoding in
    union
      [ case
          (Tag 0)
          ~title:"Revealed"
          (obj1 (req "nonce" Nonce.encoding))
          (function Revealed nonce -> Some nonce | _ -> None)
          (fun nonce -> Revealed nonce);
        case
          (Tag 1)
          ~title:"Missing"
          (obj1 (req "hash" Nonce_hash.encoding))
          (function Missing nonce -> Some nonce | _ -> None)
          (fun nonce -> Missing nonce);
        case
          (Tag 2)
          ~title:"Forgotten"
          empty
          (function Forgotten -> Some () | _ -> None)
          (fun () -> Forgotten) ]

  module S = struct
    let get =
      RPC_service.get_service
        ~description:"Info about the nonce of a previous block."
        ~query:RPC_query.empty
        ~output:info_encoding
        RPC_path.(custom_root / "context" / "nonces" /: Raw_level.rpc_arg)
  end

  let register () =
    let open Services_registration in
    register1 S.get (fun ctxt raw_level () () ->
        let level = Level.from_raw ctxt raw_level in
        Nonce.get ctxt level
        >>= function
        | Ok (Revealed nonce) ->
            return (Revealed nonce)
        | Ok (Unrevealed {nonce_hash; _}) ->
            return (Missing nonce_hash)
        | Error _ ->
            return Forgotten)

  let get ctxt block level =
    RPC_context.make_call1 S.get ctxt block level () ()
end

module Contract = Contract_services
module Constants = Constants_services
module Delegate = Delegate_services
module Helpers = Helpers_services
module Forge = Helpers_services.Forge
module Parse = Helpers_services.Parse
module Voting = Voting_services

let register () =
  Contract.register () ;
  Constants.register () ;
  Delegate.register () ;
  Helpers.register () ;
  Nonce.register () ;
  Voting.register ()
alpha_services_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Definition custom_root {A : Type}
  : Tezos_protocol_environment_alpha__Environment.RPC_path.context A :=
  RPC_path.open_root.

Module Seed.
  Module S.
    Import Data_encoding.
    
    Definition seed
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        variant
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        unit Tezos_raw_protocol_alpha.Alpha_context.Seed.seed :=
      RPC_service.post_service
        (Some "Seed of the cycle to which the block belongs." % string)
        RPC_query.empty empty Seed.seed_encoding
        (op_div (op_div custom_root "context" % string) "seed" % string).
  End S.
  
  (* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
  Compute
    register0 S.seed
      (fun ctxt =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            let l := Level.current ctxt in
            Seed.for_cycle ctxt (cycle l)).
  
  Definition get {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (block : D)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_raw_protocol_alpha.Alpha_context.Seed.seed) :=
    RPC_context.make_call0 S.seed ctxt block tt tt.
End Seed.

Module Nonce.
  Inductive info : Type :=
  | Revealed : Tezos_raw_protocol_alpha.Alpha_context.Nonce.t -> info
  | Missing : Tezos_raw_protocol_alpha.Nonce_hash.t -> info
  | Forgotten : info.
  
  Definition info_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding info :=
    union None
      (cons
        (case "Revealed" % string None
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
          (obj1 (req None None "nonce" % string Nonce.encoding))
          (fun function_parameter =>
            match function_parameter with
            | Revealed nonce => Some nonce
            | _ => None
            end) (fun nonce => Revealed nonce))
        (cons
          (case "Missing" % string None
            (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
            (obj1 (req None None "hash" % string Nonce_hash.encoding))
            (fun function_parameter =>
              match function_parameter with
              | Missing nonce => Some nonce
              | _ => None
              end) (fun nonce => Missing nonce))
          (cons
            (case "Forgotten" % string None
              (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 2)
              empty
              (fun function_parameter =>
                match function_parameter with
                | Forgotten => Some tt
                | _ => None
                end)
              (fun function_parameter =>
                let 'tt := function_parameter in
                Forgotten)) []))).
  
  Module S.
    Definition get
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        variant
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
          Tezos_raw_protocol_alpha.Alpha_context.Raw_level.raw_level) unit unit
        info :=
      RPC_service.get_service
        (Some "Info about the nonce of a previous block." % string)
        RPC_query.empty info_encoding
        (op_divcolon
          (op_div (op_div custom_root "context" % string) "nonces" % string)
          Raw_level.rpc_arg).
  End S.
  
  Definition register (function_parameter : unit) : unit :=
    let 'tt := function_parameter in
    register1 S.get
      (fun ctxt =>
        fun raw_level =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              let level := Level.from_raw ctxt None raw_level in
              op_gtgteq (Nonce.get ctxt level)
                (fun function_parameter =>
                  match function_parameter with
                  |
                    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                      (Tezos_raw_protocol_alpha.Alpha_context.Nonce.Revealed
                        nonce) => __return (Revealed nonce)
                  |
                    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                      (Tezos_raw_protocol_alpha.Alpha_context.Nonce.Unrevealed
                        {| nonce_hash := nonce_hash |}) =>
                    __return (Missing nonce_hash)
                  |
                    Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                      _ => __return Forgotten
                  end)).
  
  Definition get {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (block : D)
    (level : Tezos_raw_protocol_alpha.Alpha_context.Raw_level.raw_level)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        info) := RPC_context.make_call1 S.get ctxt block level tt tt.
End Nonce.

Module Contract := Contract_services.

Module Constants := Constants_services.

Module Delegate := Delegate_services.

Module Helpers := Helpers_services.

Module Forge := Helpers_services.Forge.

Module Parse := Helpers_services.Parse.

Module Voting := Voting_services.

Definition register (function_parameter : unit) : unit :=
  let 'tt := function_parameter in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Contract.register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Constants.register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Delegate.register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Helpers.register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Nonce.register tt in
  Voting.register tt.
alpha_services.mli 46 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

module Seed : sig
  val get : 'a #RPC_context.simple -> 'a -> Seed.seed shell_tzresult Lwt.t
end

module Nonce : sig
  type info = Revealed of Nonce.t | Missing of Nonce_hash.t | Forgotten

  val get :
    'a #RPC_context.simple -> 'a -> Raw_level.t -> info shell_tzresult Lwt.t
end

module Contract = Contract_services
module Constants = Constants_services
module Delegate = Delegate_services
module Helpers = Helpers_services
module Forge = Helpers_services.Forge
module Parse = Helpers_services.Parse
module Voting = Voting_services

val register : unit -> unit
alpha_services_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module Seed.
  Parameter get : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          Tezos_raw_protocol_alpha.Alpha_context.Seed.seed).
End Seed.

Module Nonce.
  Inductive info : Type :=
  | Revealed : Tezos_raw_protocol_alpha.Alpha_context.Nonce.t -> info
  | Missing : Tezos_raw_protocol_alpha.Nonce_hash.t -> info
  | Forgotten : info.
  
  Parameter get : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            info).
End Nonce.

unhandled_module

unhandled_module

unhandled_module

unhandled_module

unhandled_module

unhandled_module

unhandled_module

Parameter register : unit -> unit.
amendment.ml 34 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

(** Returns the proposal submitted by the most delegates.
    Returns None in case of a tie, if proposal quorum is below required
    minimum or if there are no proposals. *)
let select_winning_proposal ctxt =
  Vote.get_proposals ctxt
  >>=? fun proposals ->
  let merge proposal vote winners =
    match winners with
    | None ->
        Some ([proposal], vote)
    | Some (winners, winners_vote) as previous ->
        if Compare.Int32.(vote = winners_vote) then
          Some (proposal :: winners, winners_vote)
        else if Compare.Int32.(vote > winners_vote) then Some ([proposal], vote)
        else previous
  in
  match Protocol_hash.Map.fold merge proposals None with
  | Some ([proposal], vote) ->
      Vote.listing_size ctxt
      >>=? fun max_vote ->
      let min_proposal_quorum = Constants.min_proposal_quorum ctxt in
      let min_vote_to_pass =
        Int32.div (Int32.mul min_proposal_quorum max_vote) 100_00l
      in
      if Compare.Int32.(vote >= min_vote_to_pass) then return_some proposal
      else return_none
  | _ ->
      return_none

(* in case of a tie, let's do nothing. *)

(** A proposal is approved if it has supermajority and the participation reaches
    the current quorum.
    Supermajority means the yays are more 8/10 of casted votes.
    The participation is the ratio of all received votes, including passes, with
    respect to the number of possible votes.
    The participation EMA (exponential moving average) uses the last
    participation EMA and the current participation./
    The expected quorum is calculated using the last participation EMA, capped
    by the min/max quorum protocol constants. *)
let check_approval_and_update_participation_ema ctxt =
  Vote.get_ballots ctxt
  >>=? fun ballots ->
  Vote.listing_size ctxt
  >>=? fun maximum_vote ->
  Vote.get_participation_ema ctxt
  >>=? fun participation_ema ->
  Vote.get_current_quorum ctxt
  >>=? fun expected_quorum ->
  (* Note overflows: considering a maximum of 8e8 tokens, with roll size as
     small as 1e3, there is a maximum of 8e5 rolls and thus votes.
     In 'participation' an Int64 is used because in the worst case 'all_votes is
     8e5 and after the multiplication is 8e9, making it potentially overflow a
     signed Int32 which is 2e9. *)
  let casted_votes = Int32.add ballots.yay ballots.nay in
  let all_votes = Int32.add casted_votes ballots.pass in
  let supermajority = Int32.div (Int32.mul 8l casted_votes) 10l in
  let participation =
    (* in centile of percentage *)
    Int64.(
      to_int32 (div (mul (of_int32 all_votes) 100_00L) (of_int32 maximum_vote)))
  in
  let outcome =
    Compare.Int32.(
      participation >= expected_quorum && ballots.yay >= supermajority)
  in
  let new_participation_ema =
    Int32.(div (add (mul 8l participation_ema) (mul 2l participation)) 10l)
  in
  Vote.set_participation_ema ctxt new_participation_ema
  >>=? fun ctxt -> return (ctxt, outcome)

(** Implements the state machine of the amendment procedure.
    Note that [freeze_listings], that computes the vote weight of each delegate,
    is run at the beginning of each voting period.
*)
let start_new_voting_period ctxt =
  Vote.get_current_period_kind ctxt
  >>=? function
  | Proposal -> (
      select_winning_proposal ctxt
      >>=? fun proposal ->
      Vote.clear_proposals ctxt
      >>= fun ctxt ->
      Vote.clear_listings ctxt
      >>=? fun ctxt ->
      match proposal with
      | None ->
          Vote.freeze_listings ctxt >>=? fun ctxt -> return ctxt
      | Some proposal ->
          Vote.init_current_proposal ctxt proposal
          >>=? fun ctxt ->
          Vote.freeze_listings ctxt
          >>=? fun ctxt ->
          Vote.set_current_period_kind ctxt Testing_vote
          >>=? fun ctxt -> return ctxt )
  | Testing_vote ->
      check_approval_and_update_participation_ema ctxt
      >>=? fun (ctxt, approved) ->
      Vote.clear_ballots ctxt
      >>= fun ctxt ->
      Vote.clear_listings ctxt
      >>=? fun ctxt ->
      if approved then
        let expiration =
          (* in two days maximum... *)
          Time.add
            (Timestamp.current ctxt)
            (Constants.test_chain_duration ctxt)
        in
        Vote.get_current_proposal ctxt
        >>=? fun proposal ->
        fork_test_chain ctxt proposal expiration
        >>= fun ctxt ->
        Vote.set_current_period_kind ctxt Testing >>=? fun ctxt -> return ctxt
      else
        Vote.clear_current_proposal ctxt
        >>=? fun ctxt ->
        Vote.freeze_listings ctxt
        >>=? fun ctxt ->
        Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt -> return ctxt
  | Testing ->
      Vote.freeze_listings ctxt
      >>=? fun ctxt ->
      Vote.set_current_period_kind ctxt Promotion_vote
      >>=? fun ctxt -> return ctxt
  | Promotion_vote ->
      check_approval_and_update_participation_ema ctxt
      >>=? fun (ctxt, approved) ->
      ( if approved then
        Vote.get_current_proposal ctxt
        >>=? fun proposal -> activate ctxt proposal >>= fun ctxt -> return ctxt
      else return ctxt )
      >>=? fun ctxt ->
      Vote.clear_ballots ctxt
      >>= fun ctxt ->
      Vote.clear_listings ctxt
      >>=? fun ctxt ->
      Vote.clear_current_proposal ctxt
      >>=? fun ctxt ->
      Vote.freeze_listings ctxt
      >>=? fun ctxt ->
      Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt -> return ctxt

type error +=
  | (* `Branch *)
      Invalid_proposal
  | Unexpected_proposal
  | Unauthorized_proposal
  | Too_many_proposals
  | Empty_proposal
  | Unexpected_ballot
  | Unauthorized_ballot

let () =
  let open Data_encoding in
  (* Invalid proposal *)
  register_error_kind
    `Branch
    ~id:"invalid_proposal"
    ~title:"Invalid proposal"
    ~description:"Ballot provided for a proposal that is not the current one."
    ~pp:(fun ppf () -> Format.fprintf ppf "Invalid proposal")
    empty
    (function Invalid_proposal -> Some () | _ -> None)
    (fun () -> Invalid_proposal) ;
  (* Unexpected proposal *)
  register_error_kind
    `Branch
    ~id:"unexpected_proposal"
    ~title:"Unexpected proposal"
    ~description:"Proposal recorded outside of a proposal period."
    ~pp:(fun ppf () -> Format.fprintf ppf "Unexpected proposal")
    empty
    (function Unexpected_proposal -> Some () | _ -> None)
    (fun () -> Unexpected_proposal) ;
  (* Unauthorized proposal *)
  register_error_kind
    `Branch
    ~id:"unauthorized_proposal"
    ~title:"Unauthorized proposal"
    ~description:
      "The delegate provided for the proposal is not in the voting listings."
    ~pp:(fun ppf () -> Format.fprintf ppf "Unauthorized proposal")
    empty
    (function Unauthorized_proposal -> Some () | _ -> None)
    (fun () -> Unauthorized_proposal) ;
  (* Unexpected ballot *)
  register_error_kind
    `Branch
    ~id:"unexpected_ballot"
    ~title:"Unexpected ballot"
    ~description:"Ballot recorded outside of a voting period."
    ~pp:(fun ppf () -> Format.fprintf ppf "Unexpected ballot")
    empty
    (function Unexpected_ballot -> Some () | _ -> None)
    (fun () -> Unexpected_ballot) ;
  (* Unauthorized ballot *)
  register_error_kind
    `Branch
    ~id:"unauthorized_ballot"
    ~title:"Unauthorized ballot"
    ~description:
      "The delegate provided for the ballot is not in the voting listings."
    ~pp:(fun ppf () -> Format.fprintf ppf "Unauthorized ballot")
    empty
    (function Unauthorized_ballot -> Some () | _ -> None)
    (fun () -> Unauthorized_ballot) ;
  (* Too many proposals *)
  register_error_kind
    `Branch
    ~id:"too_many_proposals"
    ~title:"Too many proposals"
    ~description:
      "The delegate reached the maximum number of allowed proposals."
    ~pp:(fun ppf () -> Format.fprintf ppf "Too many proposals")
    empty
    (function Too_many_proposals -> Some () | _ -> None)
    (fun () -> Too_many_proposals) ;
  (* Empty proposal *)
  register_error_kind
    `Branch
    ~id:"empty_proposal"
    ~title:"Empty proposal"
    ~description:"Proposal lists cannot be empty."
    ~pp:(fun ppf () -> Format.fprintf ppf "Empty proposal")
    empty
    (function Empty_proposal -> Some () | _ -> None)
    (fun () -> Empty_proposal)

(* @return [true] if [List.length l] > [n] w/o computing length *)
let rec longer_than l n =
  if Compare.Int.(n < 0) then assert false
  else
    match l with
    | [] ->
        false
    | _ :: rest ->
        if Compare.Int.(n = 0) then true
        else (* n > 0 *)
          longer_than rest (n - 1)

let record_proposals ctxt delegate proposals =
  (match proposals with [] -> fail Empty_proposal | _ :: _ -> return_unit)
  >>=? fun () ->
  Vote.get_current_period_kind ctxt
  >>=? function
  | Proposal ->
      Vote.in_listings ctxt delegate
      >>= fun in_listings ->
      if in_listings then
        Vote.recorded_proposal_count_for_delegate ctxt delegate
        >>=? fun count ->
        fail_when
          (longer_than proposals (Constants.max_proposals_per_delegate - count))
          Too_many_proposals
        >>=? fun () ->
        fold_left_s
          (fun ctxt proposal -> Vote.record_proposal ctxt proposal delegate)
          ctxt
          proposals
        >>=? fun ctxt -> return ctxt
      else fail Unauthorized_proposal
  | Testing_vote | Testing | Promotion_vote ->
      fail Unexpected_proposal

let record_ballot ctxt delegate proposal ballot =
  Vote.get_current_period_kind ctxt
  >>=? function
  | Testing_vote | Promotion_vote ->
      Vote.get_current_proposal ctxt
      >>=? fun current_proposal ->
      fail_unless
        (Protocol_hash.equal proposal current_proposal)
        Invalid_proposal
      >>=? fun () ->
      Vote.has_recorded_ballot ctxt delegate
      >>= fun has_ballot ->
      fail_when has_ballot Unauthorized_ballot
      >>=? fun () ->
      Vote.in_listings ctxt delegate
      >>= fun in_listings ->
      if in_listings then Vote.record_ballot ctxt delegate ballot
      else fail Unauthorized_ballot
  | Testing | Proposal ->
      fail Unexpected_ballot

let last_of_a_voting_period ctxt l =
  Compare.Int32.(
    Int32.succ l.Level.voting_period_position
    = Constants.blocks_per_voting_period ctxt)

let may_start_new_voting_period ctxt =
  let level = Level.current ctxt in
  if last_of_a_voting_period ctxt level then start_new_voting_period ctxt
  else return ctxt
amendment_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Definition select_winning_proposal
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option
        Tezos_protocol_environment_alpha__Environment.Protocol_hash.Map.key)) :=
  op_gtgteqquestion (Vote.get_proposals ctxt)
    (fun proposals =>
      let merge {A : Type}
        (proposal : A) (vote :
        Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
        (winners :
        option
          (list A *
            Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.t)))
        : option
          (list A *
            Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.t)) :=
        match winners with
        | None => Some ((cons proposal []), vote)
        | (Some (winners, winners_vote)) as previous =>
          if
            Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
              vote winners_vote then
            Some ((cons proposal winners), winners_vote)
          else
            if
              Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
                vote winners_vote then
              Some ((cons proposal []), vote)
            else
              previous
        end in
      match Protocol_hash.Map.fold merge proposals None with
      | Some (cons proposal [], vote) =>
        op_gtgteqquestion (Vote.listing_size ctxt)
          (fun max_vote =>
            let min_proposal_quorum := Constants.min_proposal_quorum ctxt in
            let min_vote_to_pass :=
              Int32.div (Int32.mul min_proposal_quorum max_vote)
                (* ❌ Constant of type int32 is converted to int *)
                10000 in
            if
              Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
                vote min_vote_to_pass then
              return_some proposal
            else
              return_none)
      | _ => return_none
      end).

Definition check_approval_and_update_participation_ema
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha__Alpha_context.context * bool)) :=
  op_gtgteqquestion (Vote.get_ballots ctxt)
    (fun ballots =>
      op_gtgteqquestion (Vote.listing_size ctxt)
        (fun maximum_vote =>
          op_gtgteqquestion (Vote.get_participation_ema ctxt)
            (fun participation_ema =>
              op_gtgteqquestion (Vote.get_current_quorum ctxt)
                (fun expected_quorum =>
                  let casted_votes := Int32.add (yay ballots) (nay ballots) in
                  let all_votes := Int32.add casted_votes (pass ballots) in
                  let supermajority :=
                    Int32.div
                      (Int32.mul
                        (* ❌ Constant of type int32 is converted to int *)
                        8 casted_votes)
                      (* ❌ Constant of type int32 is converted to int *)
                      10 in
                  let participation :=
                    to_int32
                      (div
                        (mul (of_int32 all_votes)
                          (* ❌ Constant of type int64 is converted to int *)
                          10000) (of_int32 maximum_vote)) in
                  let outcome :=
                    op_andand
                      (Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
                        participation expected_quorum)
                      (Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
                        (yay ballots) supermajority) in
                  let new_participation_ema :=
                    div
                      (add
                        (mul
                          (* ❌ Constant of type int32 is converted to int *)
                          8 participation_ema)
                        (mul
                          (* ❌ Constant of type int32 is converted to int *)
                          2 participation))
                      (* ❌ Constant of type int32 is converted to int *)
                      10 in
                  op_gtgteqquestion
                    (Vote.set_participation_ema ctxt new_participation_ema)
                    (fun ctxt => __return (ctxt, outcome)))))).

Definition start_new_voting_period
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha__Alpha_context.context) :=
  op_gtgteqquestion (Vote.get_current_period_kind ctxt)
    (fun function_parameter =>
      match function_parameter with
      | Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Proposal =>
        op_gtgteqquestion (select_winning_proposal ctxt)
          (fun proposal =>
            op_gtgteq (Vote.clear_proposals ctxt)
              (fun ctxt =>
                op_gtgteqquestion (Vote.clear_listings ctxt)
                  (fun ctxt =>
                    match proposal with
                    | None =>
                      op_gtgteqquestion (Vote.freeze_listings ctxt)
                        (fun ctxt => __return ctxt)
                    | Some proposal =>
                      op_gtgteqquestion
                        (Vote.init_current_proposal ctxt proposal)
                        (fun ctxt =>
                          op_gtgteqquestion (Vote.freeze_listings ctxt)
                            (fun ctxt =>
                              op_gtgteqquestion
                                (Vote.set_current_period_kind ctxt
                                  Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing_vote)
                                (fun ctxt => __return ctxt)))
                    end)))
      | Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing_vote =>
        op_gtgteqquestion (check_approval_and_update_participation_ema ctxt)
          (fun function_parameter =>
            let '(ctxt, approved) := function_parameter in
            op_gtgteq (Vote.clear_ballots ctxt)
              (fun ctxt =>
                op_gtgteqquestion (Vote.clear_listings ctxt)
                  (fun ctxt =>
                    if approved then
                      let expiration :=
                        Time.add (Timestamp.current ctxt)
                          (Constants.test_chain_duration ctxt) in
                      op_gtgteqquestion (Vote.get_current_proposal ctxt)
                        (fun proposal =>
                          op_gtgteq (fork_test_chain ctxt proposal expiration)
                            (fun ctxt =>
                              op_gtgteqquestion
                                (Vote.set_current_period_kind ctxt
                                  Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing)
                                (fun ctxt => __return ctxt)))
                    else
                      op_gtgteqquestion (Vote.clear_current_proposal ctxt)
                        (fun ctxt =>
                          op_gtgteqquestion (Vote.freeze_listings ctxt)
                            (fun ctxt =>
                              op_gtgteqquestion
                                (Vote.set_current_period_kind ctxt
                                  Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Proposal)
                                (fun ctxt => __return ctxt))))))
      | Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing =>
        op_gtgteqquestion (Vote.freeze_listings ctxt)
          (fun ctxt =>
            op_gtgteqquestion
              (Vote.set_current_period_kind ctxt
                Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Promotion_vote)
              (fun ctxt => __return ctxt))
      | Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Promotion_vote =>
        op_gtgteqquestion (check_approval_and_update_participation_ema ctxt)
          (fun function_parameter =>
            let '(ctxt, approved) := function_parameter in
            op_gtgteqquestion
              (if approved then
                op_gtgteqquestion (Vote.get_current_proposal ctxt)
                  (fun proposal =>
                    op_gtgteq (activate ctxt proposal)
                      (fun ctxt => __return ctxt))
              else
                __return ctxt)
              (fun ctxt =>
                op_gtgteq (Vote.clear_ballots ctxt)
                  (fun ctxt =>
                    op_gtgteqquestion (Vote.clear_listings ctxt)
                      (fun ctxt =>
                        op_gtgteqquestion (Vote.clear_current_proposal ctxt)
                          (fun ctxt =>
                            op_gtgteqquestion (Vote.freeze_listings ctxt)
                              (fun ctxt =>
                                op_gtgteqquestion
                                  (Vote.set_current_period_kind ctxt
                                    Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Proposal)
                                  (fun ctxt => __return ctxt)))))))
      end).

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "invalid_proposal" % string "Invalid proposal" % string
      "Ballot provided for a proposal that is not the current one." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Invalid proposal" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Invalid proposal" % string))) empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_proposal
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_proposal)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "unexpected_proposal" % string "Unexpected proposal" % string
      "Proposal recorded outside of a proposal period." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Unexpected proposal" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Unexpected proposal" % string))) empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_proposal
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_proposal)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "unauthorized_proposal" % string "Unauthorized proposal" % string
      "The delegate provided for the proposal is not in the voting listings." %
        string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Unauthorized proposal" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Unauthorized proposal" % string))) empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_proposal
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_proposal)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "unexpected_ballot" % string "Unexpected ballot" % string
      "Ballot recorded outside of a voting period." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Unexpected ballot" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Unexpected ballot" % string))) empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_ballot
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_ballot)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "unauthorized_ballot" % string "Unauthorized ballot" % string
      "The delegate provided for the ballot is not in the voting listings." %
        string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Unauthorized ballot" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Unauthorized ballot" % string))) empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_ballot
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_ballot)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "too_many_proposals" % string "Too many proposals" % string
      "The delegate reached the maximum number of allowed proposals." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Too many proposals" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Too many proposals" % string))) empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Too_many_proposals
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Too_many_proposals)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "empty_proposal" % string "Empty proposal" % string
    "Proposal lists cannot be empty." % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "Empty proposal" % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "Empty proposal" % string))) empty
    (fun function_parameter =>
      match function_parameter with
      | Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_proposal
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_proposal).

Fixpoint longer_than {A : Type}
  (l : list A)
  (n :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : bool :=
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
      n 0 then
    (* ❌ Assert instruction is not handled. *)
    assert false
  else
    match l with
    | [] => false
    | cons _ rest =>
      if
        Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
          n 0 then
        true
      else
        longer_than rest (op_minus n 1)
    end.

Definition record_proposals
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (delegate : Tezos_raw_protocol_alpha__Alpha_context.public_key_hash)
  (proposals :
    list
      Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha__Alpha_context.context) :=
  op_gtgteqquestion
    match proposals with
    | [] =>
      fail
        Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_proposal
    | cons _ _ => return_unit
    end
    (fun function_parameter =>
      let 'tt := function_parameter in
      op_gtgteqquestion (Vote.get_current_period_kind ctxt)
        (fun function_parameter =>
          match function_parameter with
          | Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Proposal =>
            op_gtgteq (Vote.in_listings ctxt delegate)
              (fun in_listings =>
                if in_listings then
                  op_gtgteqquestion
                    (Vote.recorded_proposal_count_for_delegate ctxt delegate)
                    (fun count =>
                      op_gtgteqquestion
                        (fail_when
                          (longer_than proposals
                            (op_minus Constants.max_proposals_per_delegate count))
                          Tezos_protocol_environment_alpha__Environment.Error_monad.Too_many_proposals)
                        (fun function_parameter =>
                          let 'tt := function_parameter in
                          op_gtgteqquestion
                            (fold_left_s
                              (fun ctxt =>
                                fun proposal =>
                                  Vote.record_proposal ctxt proposal delegate)
                              ctxt proposals) (fun ctxt => __return ctxt)))
                else
                  fail
                    Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_proposal)
          |
            Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing_vote |
              Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing |
              Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Promotion_vote
            =>
            fail
              Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_proposal
          end)).

Definition record_ballot
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (delegate : Tezos_raw_protocol_alpha__Alpha_context.public_key_hash)
  (proposal :
    Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (ballot : Tezos_raw_protocol_alpha.Alpha_context.Vote.ballot)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha__Alpha_context.context) :=
  op_gtgteqquestion (Vote.get_current_period_kind ctxt)
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing_vote |
          Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Promotion_vote
        =>
        op_gtgteqquestion (Vote.get_current_proposal ctxt)
          (fun current_proposal =>
            op_gtgteqquestion
              (fail_unless
                (Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.equal)
                  proposal current_proposal)
                Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_proposal)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteq (Vote.has_recorded_ballot ctxt delegate)
                  (fun has_ballot =>
                    op_gtgteqquestion
                      (fail_when has_ballot
                        Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_ballot)
                      (fun function_parameter =>
                        let 'tt := function_parameter in
                        op_gtgteq (Vote.in_listings ctxt delegate)
                          (fun in_listings =>
                            if in_listings then
                              Vote.record_ballot ctxt delegate ballot
                            else
                              fail
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_ballot)))))
      |
        Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Testing |
          Tezos_raw_protocol_alpha__Alpha_context.Voting_period.Proposal =>
        fail
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_ballot
      end).

Definition last_of_a_voting_period
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (l : Tezos_raw_protocol_alpha.Alpha_context.Level.t) : bool :=
  Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
    (Int32.succ (Level.voting_period_position l))
    (Constants.blocks_per_voting_period ctxt).

Definition may_start_new_voting_period
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha__Alpha_context.context) :=
  let level := Level.current ctxt in
  if last_of_a_voting_period ctxt level then
    start_new_voting_period ctxt
  else
    __return ctxt.
amendment.mli 5 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(**
   Only delegates with at least one roll take part in the amendment procedure.
   It works as follows:
   - Proposal period: delegates can submit protocol amendment proposals using
     the proposal operation. At the end of a proposal period, the proposal with
     most supporters is selected and we move to a testing_vote period.
     If there are no proposals, or a tie between proposals, a new proposal
     period starts.
   - Testing_vote period: delegates can cast votes to test or not the winning
     proposal using the ballot operation.
     At the end of a testing_vote period if participation reaches the quorum
     and the proposal has a supermajority in favor, we proceed to a testing
     period. Otherwise we go back to a proposal period.
     In any case, if there is enough participation the quorum is updated.
   - Testing period: a test chain is forked for the lengh of the period.
     At the end of a testing period we move to a promotion_vote period.
   - Promotion_vote period: delegates can cast votes to promote or not the
     tested proposal using the ballot operation.
     At the end of a promotion_vote period if participation reaches the quorum
     and the tested proposal has a supermajority in favor, it is activated as
     the new protocol. Otherwise we go back to a proposal period.
     In any case, if there is enough participation the quorum is updated.
*)

open Alpha_context

(** If at the end of a voting period, moves to the next one following
    the state machine of the amendment procedure. *)
val may_start_new_voting_period : context -> context tzresult Lwt.t

type error +=
  | Unexpected_proposal
  | Unauthorized_proposal
  | Too_many_proposals
  | Empty_proposal

(** Records a list of proposals for a delegate.
    @raise Unexpected_proposal if [ctxt] is not in a proposal period.
    @raise Unauthorized_proposal if [delegate] is not in the listing. *)
val record_proposals :
  context -> public_key_hash -> Protocol_hash.t list -> context tzresult Lwt.t

type error += Invalid_proposal | Unexpected_ballot | Unauthorized_ballot

val record_ballot :
  context ->
  public_key_hash ->
  Protocol_hash.t ->
  Vote.ballot ->
  context tzresult Lwt.t
amendment_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter may_start_new_voting_period :
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.context).

extensible_type

Parameter record_proposals :
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
    list
      Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
      ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Alpha_context.context).

extensible_type

Parameter record_ballot :
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
    Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
      ->
      Tezos_raw_protocol_alpha.Alpha_context.Vote.ballot ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Alpha_context.context).
apply.ml 113 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Tezos Protocol Implementation - Main Entry Points *)

open Alpha_context

type error += Wrong_voting_period of Voting_period.t * Voting_period.t

(* `Temporary *)

type error += Wrong_endorsement_predecessor of Block_hash.t * Block_hash.t

(* `Temporary *)

type error += Duplicate_endorsement of Signature.Public_key_hash.t

(* `Branch *)

type error += Invalid_endorsement_level

type error += Invalid_commitment of {expected : bool}

type error += Internal_operation_replay of packed_internal_operation

type error += Invalid_double_endorsement_evidence (* `Permanent *)

type error +=
  | Inconsistent_double_endorsement_evidence of {
      delegate1 : Signature.Public_key_hash.t;
      delegate2 : Signature.Public_key_hash.t;
    }

(* `Permanent *)

type error += Unrequired_double_endorsement_evidence (* `Branch*)

type error +=
  | Too_early_double_endorsement_evidence of {
      level : Raw_level.t;
      current : Raw_level.t;
    }

(* `Temporary *)

type error +=
  | Outdated_double_endorsement_evidence of {
      level : Raw_level.t;
      last : Raw_level.t;
    }

(* `Permanent *)

type error +=
  | Invalid_double_baking_evidence of {
      hash1 : Block_hash.t;
      level1 : Int32.t;
      hash2 : Block_hash.t;
      level2 : Int32.t;
    }

(* `Permanent *)

type error +=
  | Inconsistent_double_baking_evidence of {
      delegate1 : Signature.Public_key_hash.t;
      delegate2 : Signature.Public_key_hash.t;
    }

(* `Permanent *)

type error += Unrequired_double_baking_evidence (* `Branch*)

type error +=
  | Too_early_double_baking_evidence of {
      level : Raw_level.t;
      current : Raw_level.t;
    }

(* `Temporary *)

type error +=
  | Outdated_double_baking_evidence of {
      level : Raw_level.t;
      last : Raw_level.t;
    }

(* `Permanent *)

type error += Invalid_activation of {pkh : Ed25519.Public_key_hash.t}

type error += Multiple_revelation

type error += Gas_quota_exceeded_init_deserialize (* Permanent *)

type error +=
  | Not_enough_endorsements_for_priority of {
      required : int;
      priority : int;
      endorsements : int;
      timestamp : Time.t;
    }

let () =
  register_error_kind
    `Temporary
    ~id:"operation.wrong_endorsement_predecessor"
    ~title:"Wrong endorsement predecessor"
    ~description:
      "Trying to include an endorsement in a block that is not the successor \
       of the endorsed one"
    ~pp:(fun ppf (e, p) ->
      Format.fprintf
        ppf
        "Wrong predecessor %a, expected %a"
        Block_hash.pp
        p
        Block_hash.pp
        e)
    Data_encoding.(
      obj2
        (req "expected" Block_hash.encoding)
        (req "provided" Block_hash.encoding))
    (function
      | Wrong_endorsement_predecessor (e, p) -> Some (e, p) | _ -> None)
    (fun (e, p) -> Wrong_endorsement_predecessor (e, p)) ;
  register_error_kind
    `Temporary
    ~id:"operation.wrong_voting_period"
    ~title:"Wrong voting period"
    ~description:
      "Trying to onclude a proposal or ballot meant for another voting period"
    ~pp:(fun ppf (e, p) ->
      Format.fprintf
        ppf
        "Wrong voting period %a, current is %a"
        Voting_period.pp
        p
        Voting_period.pp
        e)
    Data_encoding.(
      obj2
        (req "current" Voting_period.encoding)
        (req "provided" Voting_period.encoding))
    (function Wrong_voting_period (e, p) -> Some (e, p) | _ -> None)
    (fun (e, p) -> Wrong_voting_period (e, p)) ;
  register_error_kind
    `Branch
    ~id:"operation.duplicate_endorsement"
    ~title:"Duplicate endorsement"
    ~description:"Two endorsements received from same delegate"
    ~pp:(fun ppf k ->
      Format.fprintf
        ppf
        "Duplicate endorsement from delegate %a (possible replay attack)."
        Signature.Public_key_hash.pp_short
        k)
    Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding))
    (function Duplicate_endorsement k -> Some k | _ -> None)
    (fun k -> Duplicate_endorsement k) ;
  register_error_kind
    `Temporary
    ~id:"operation.invalid_endorsement_level"
    ~title:"Unexpected level in endorsement"
    ~description:
      "The level of an endorsement is inconsistent with the  provided block \
       hash."
    ~pp:(fun ppf () -> Format.fprintf ppf "Unexpected level in endorsement.")
    Data_encoding.unit
    (function Invalid_endorsement_level -> Some () | _ -> None)
    (fun () -> Invalid_endorsement_level) ;
  register_error_kind
    `Permanent
    ~id:"block.invalid_commitment"
    ~title:"Invalid commitment in block header"
    ~description:"The block header has invalid commitment."
    ~pp:(fun ppf expected ->
      if expected then
        Format.fprintf ppf "Missing seed's nonce commitment in block header."
      else
        Format.fprintf
          ppf
          "Unexpected seed's nonce commitment in block header.")
    Data_encoding.(obj1 (req "expected" bool))
    (function Invalid_commitment {expected} -> Some expected | _ -> None)
    (fun expected -> Invalid_commitment {expected}) ;
  register_error_kind
    `Permanent
    ~id:"internal_operation_replay"
    ~title:"Internal operation replay"
    ~description:"An internal operation was emitted twice by a script"
    ~pp:(fun ppf (Internal_operation {nonce; _}) ->
      Format.fprintf
        ppf
        "Internal operation %d was emitted twice by a script"
        nonce)
    Operation.internal_operation_encoding
    (function Internal_operation_replay op -> Some op | _ -> None)
    (fun op -> Internal_operation_replay op) ;
  register_error_kind
    `Permanent
    ~id:"block.invalid_double_endorsement_evidence"
    ~title:"Invalid double endorsement evidence"
    ~description:"A double-endorsement evidence is malformed"
    ~pp:(fun ppf () ->
      Format.fprintf ppf "Malformed double-endorsement evidence")
    Data_encoding.empty
    (function Invalid_double_endorsement_evidence -> Some () | _ -> None)
    (fun () -> Invalid_double_endorsement_evidence) ;
  register_error_kind
    `Permanent
    ~id:"block.inconsistent_double_endorsement_evidence"
    ~title:"Inconsistent double endorsement evidence"
    ~description:
      "A double-endorsement evidence is inconsistent  (two distinct delegates)"
    ~pp:(fun ppf (delegate1, delegate2) ->
      Format.fprintf
        ppf
        "Inconsistent double-endorsement evidence  (distinct delegate: %a and \
         %a)"
        Signature.Public_key_hash.pp_short
        delegate1
        Signature.Public_key_hash.pp_short
        delegate2)
    Data_encoding.(
      obj2
        (req "delegate1" Signature.Public_key_hash.encoding)
        (req "delegate2" Signature.Public_key_hash.encoding))
    (function
      | Inconsistent_double_endorsement_evidence {delegate1; delegate2} ->
          Some (delegate1, delegate2)
      | _ ->
          None)
    (fun (delegate1, delegate2) ->
      Inconsistent_double_endorsement_evidence {delegate1; delegate2}) ;
  register_error_kind
    `Branch
    ~id:"block.unrequired_double_endorsement_evidence"
    ~title:"Unrequired double endorsement evidence"
    ~description:"A double-endorsement evidence is unrequired"
    ~pp:(fun ppf () ->
      Format.fprintf
        ppf
        "A valid double-endorsement operation cannot  be applied: the \
         associated delegate  has previously been denunciated in this cycle.")
    Data_encoding.empty
    (function Unrequired_double_endorsement_evidence -> Some () | _ -> None)
    (fun () -> Unrequired_double_endorsement_evidence) ;
  register_error_kind
    `Temporary
    ~id:"block.too_early_double_endorsement_evidence"
    ~title:"Too early double endorsement evidence"
    ~description:"A double-endorsement evidence is in the future"
    ~pp:(fun ppf (level, current) ->
      Format.fprintf
        ppf
        "A double-endorsement evidence is in the future  (current level: %a, \
         endorsement level: %a)"
        Raw_level.pp
        current
        Raw_level.pp
        level)
    Data_encoding.(
      obj2 (req "level" Raw_level.encoding) (req "current" Raw_level.encoding))
    (function
      | Too_early_double_endorsement_evidence {level; current} ->
          Some (level, current)
      | _ ->
          None)
    (fun (level, current) ->
      Too_early_double_endorsement_evidence {level; current}) ;
  register_error_kind
    `Permanent
    ~id:"block.outdated_double_endorsement_evidence"
    ~title:"Outdated double endorsement evidence"
    ~description:"A double-endorsement evidence is outdated."
    ~pp:(fun ppf (level, last) ->
      Format.fprintf
        ppf
        "A double-endorsement evidence is outdated  (last acceptable level: \
         %a, endorsement level: %a)"
        Raw_level.pp
        last
        Raw_level.pp
        level)
    Data_encoding.(
      obj2 (req "level" Raw_level.encoding) (req "last" Raw_level.encoding))
    (function
      | Outdated_double_endorsement_evidence {level; last} ->
          Some (level, last)
      | _ ->
          None)
    (fun (level, last) -> Outdated_double_endorsement_evidence {level; last}) ;
  register_error_kind
    `Permanent
    ~id:"block.invalid_double_baking_evidence"
    ~title:"Invalid double baking evidence"
    ~description:
      "A double-baking evidence is inconsistent  (two distinct level)"
    ~pp:(fun ppf (hash1, level1, hash2, level2) ->
      Format.fprintf
        ppf
        "Invalid double-baking evidence (hash: %a and %a, levels: %ld and %ld)"
        Block_hash.pp
        hash1
        Block_hash.pp
        hash2
        level1
        level2)
    Data_encoding.(
      obj4
        (req "hash1" Block_hash.encoding)
        (req "level1" int32)
        (req "hash2" Block_hash.encoding)
        (req "level2" int32))
    (function
      | Invalid_double_baking_evidence {hash1; level1; hash2; level2} ->
          Some (hash1, level1, hash2, level2)
      | _ ->
          None)
    (fun (hash1, level1, hash2, level2) ->
      Invalid_double_baking_evidence {hash1; level1; hash2; level2}) ;
  register_error_kind
    `Permanent
    ~id:"block.inconsistent_double_baking_evidence"
    ~title:"Inconsistent double baking evidence"
    ~description:
      "A double-baking evidence is inconsistent  (two distinct delegates)"
    ~pp:(fun ppf (delegate1, delegate2) ->
      Format.fprintf
        ppf
        "Inconsistent double-baking evidence  (distinct delegate: %a and %a)"
        Signature.Public_key_hash.pp_short
        delegate1
        Signature.Public_key_hash.pp_short
        delegate2)
    Data_encoding.(
      obj2
        (req "delegate1" Signature.Public_key_hash.encoding)
        (req "delegate2" Signature.Public_key_hash.encoding))
    (function
      | Inconsistent_double_baking_evidence {delegate1; delegate2} ->
          Some (delegate1, delegate2)
      | _ ->
          None)
    (fun (delegate1, delegate2) ->
      Inconsistent_double_baking_evidence {delegate1; delegate2}) ;
  register_error_kind
    `Branch
    ~id:"block.unrequired_double_baking_evidence"
    ~title:"Unrequired double baking evidence"
    ~description:"A double-baking evidence is unrequired"
    ~pp:(fun ppf () ->
      Format.fprintf
        ppf
        "A valid double-baking operation cannot  be applied: the associated \
         delegate  has previously been denunciated in this cycle.")
    Data_encoding.empty
    (function Unrequired_double_baking_evidence -> Some () | _ -> None)
    (fun () -> Unrequired_double_baking_evidence) ;
  register_error_kind
    `Temporary
    ~id:"block.too_early_double_baking_evidence"
    ~title:"Too early double baking evidence"
    ~description:"A double-baking evidence is in the future"
    ~pp:(fun ppf (level, current) ->
      Format.fprintf
        ppf
        "A double-baking evidence is in the future  (current level: %a, \
         baking level: %a)"
        Raw_level.pp
        current
        Raw_level.pp
        level)
    Data_encoding.(
      obj2 (req "level" Raw_level.encoding) (req "current" Raw_level.encoding))
    (function
      | Too_early_double_baking_evidence {level; current} ->
          Some (level, current)
      | _ ->
          None)
    (fun (level, current) -> Too_early_double_baking_evidence {level; current}) ;
  register_error_kind
    `Permanent
    ~id:"block.outdated_double_baking_evidence"
    ~title:"Outdated double baking evidence"
    ~description:"A double-baking evidence is outdated."
    ~pp:(fun ppf (level, last) ->
      Format.fprintf
        ppf
        "A double-baking evidence is outdated  (last acceptable level: %a, \
         baking level: %a)"
        Raw_level.pp
        last
        Raw_level.pp
        level)
    Data_encoding.(
      obj2 (req "level" Raw_level.encoding) (req "last" Raw_level.encoding))
    (function
      | Outdated_double_baking_evidence {level; last} ->
          Some (level, last)
      | _ ->
          None)
    (fun (level, last) -> Outdated_double_baking_evidence {level; last}) ;
  register_error_kind
    `Permanent
    ~id:"operation.invalid_activation"
    ~title:"Invalid activation"
    ~description:
      "The given key and secret do not correspond to any existing \
       preallocated contract"
    ~pp:(fun ppf pkh ->
      Format.fprintf
        ppf
        "Invalid activation. The public key %a does not match any commitment."
        Ed25519.Public_key_hash.pp
        pkh)
    Data_encoding.(obj1 (req "pkh" Ed25519.Public_key_hash.encoding))
    (function Invalid_activation {pkh} -> Some pkh | _ -> None)
    (fun pkh -> Invalid_activation {pkh}) ;
  register_error_kind
    `Permanent
    ~id:"block.multiple_revelation"
    ~title:"Multiple revelations were included in a manager operation"
    ~description:
      "A manager operation should not contain more than one revelation"
    ~pp:(fun ppf () ->
      Format.fprintf
        ppf
        "Multiple revelations were included in a manager operation")
    Data_encoding.empty
    (function Multiple_revelation -> Some () | _ -> None)
    (fun () -> Multiple_revelation) ;
  register_error_kind
    `Permanent
    ~id:"gas_exhausted.init_deserialize"
    ~title:"Not enough gas for initial deserialization of script expresions"
    ~description:
      "Gas limit was not high enough to deserialize the transaction \
       parameters or origination script code or initial storage, making the \
       operation impossible to parse within the provided gas bounds."
    Data_encoding.empty
    (function Gas_quota_exceeded_init_deserialize -> Some () | _ -> None)
    (fun () -> Gas_quota_exceeded_init_deserialize) ;
  register_error_kind
    `Permanent
    ~id:"operation.not_enought_endorsements_for_priority"
    ~title:"Not enough endorsements for priority"
    ~description:
      "The block being validated does not include the required minimum number \
       of endorsements for this priority."
    ~pp:(fun ppf (required, endorsements, priority, timestamp) ->
      Format.fprintf
        ppf
        "Wrong number of endorsements (%i) for priority (%i), %i are expected \
         at %a"
        endorsements
        priority
        required
        Time.pp_hum
        timestamp)
    Data_encoding.(
      obj4
        (req "required" int31)
        (req "endorsements" int31)
        (req "priority" int31)
        (req "timestamp" Time.encoding))
    (function
      | Not_enough_endorsements_for_priority
          {required; endorsements; priority; timestamp} ->
          Some (required, endorsements, priority, timestamp)
      | _ ->
          None)
    (fun (required, endorsements, priority, timestamp) ->
      Not_enough_endorsements_for_priority
        {required; endorsements; priority; timestamp})

open Apply_results

let apply_manager_operation_content :
    type kind.
    Alpha_context.t ->
    Script_ir_translator.unparsing_mode ->
    payer:Contract.t ->
    source:Contract.t ->
    chain_id:Chain_id.t ->
    internal:bool ->
    kind manager_operation ->
    ( context
    * kind successful_manager_operation_result
    * packed_internal_operation list )
    tzresult
    Lwt.t =
 fun ctxt mode ~payer ~source ~chain_id ~internal operation ->
  let before_operation =
    (* This context is not used for backtracking. Only to compute
         gas consumption and originations for the operation result. *)
    ctxt
  in
  Contract.must_exist ctxt source
  >>=? fun () ->
  Lwt.return (Gas.consume ctxt Michelson_v1_gas.Cost_of.manager_operation)
  >>=? fun ctxt ->
  match operation with
  | Reveal _ ->
      return
        (* No-op: action already performed by `precheck_manager_contents`. *)
        ( ctxt,
          ( Reveal_result
              {consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt}
            : kind successful_manager_operation_result ),
          [] )
  | Transaction {amount; parameters; destination; entrypoint} -> (
      Contract.spend ctxt source amount
      >>=? fun ctxt ->
      ( match Contract.is_implicit destination with
      | None ->
          return (ctxt, [], false)
      | Some _ -> (
          Contract.allocated ctxt destination
          >>=? function
          | true ->
              return (ctxt, [], false)
          | false ->
              Fees.origination_burn ctxt
              >>=? fun (ctxt, origination_burn) ->
              return
                ( ctxt,
                  [(Delegate.Contract payer, Delegate.Debited origination_burn)],
                  true ) ) )
      >>=? fun (ctxt, maybe_burn_balance_update, allocated_destination_contract)
               ->
      Contract.credit ctxt destination amount
      >>=? fun ctxt ->
      Contract.get_script ctxt destination
      >>=? fun (ctxt, script) ->
      match script with
      | None ->
          ( match entrypoint with
          | "default" ->
              return ()
          | entrypoint ->
              fail (Script_tc_errors.No_such_entrypoint entrypoint) )
          >>=? (fun () ->
                 Script.force_decode ctxt parameters
                 >>=? fun (arg, ctxt) ->
                 (* see [note] *)
                 (* [note]: for toplevel ops, cost is nil since the
               lazy value has already been forced at precheck, so
               we compute and consume the full cost again *)
                 let cost_arg = Script.deserialized_cost arg in
                 Lwt.return (Gas.consume ctxt cost_arg)
                 >>=? fun ctxt ->
                 match Micheline.root arg with
                 | Prim (_, D_Unit, [], _) ->
                     (* Allow [Unit] parameter to non-scripted contracts. *)
                     return ctxt
                 | _ ->
                     fail
                       (Script_interpreter.Bad_contract_parameter destination))
          >>=? fun ctxt ->
          let result =
            Transaction_result
              {
                storage = None;
                big_map_diff = None;
                balance_updates =
                  Delegate.cleanup_balance_updates
                    ( [ (Delegate.Contract source, Delegate.Debited amount);
                        (Contract destination, Credited amount) ]
                    @ maybe_burn_balance_update );
                originated_contracts = [];
                consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt;
                storage_size = Z.zero;
                paid_storage_size_diff = Z.zero;
                allocated_destination_contract;
              }
          in
          return (ctxt, result, [])
      | Some script ->
          Script.force_decode ctxt parameters
          >>=? fun (parameter, ctxt) ->
          (* see [note] *)
          let cost_parameter = Script.deserialized_cost parameter in
          Lwt.return (Gas.consume ctxt cost_parameter)
          >>=? fun ctxt ->
          let step_constants =
            let open Script_interpreter in
            {source; payer; self = destination; amount; chain_id}
          in
          Script_interpreter.execute
            ctxt
            mode
            step_constants
            ~script
            ~parameter
            ~entrypoint
          >>=? fun {ctxt; storage; big_map_diff; operations} ->
          Contract.update_script_storage ctxt destination storage big_map_diff
          >>=? fun ctxt ->
          Fees.record_paid_storage_space ctxt destination
          >>=? fun (ctxt, new_size, paid_storage_size_diff, fees) ->
          Contract.originated_from_current_nonce
            ~since:before_operation
            ~until:ctxt
          >>=? fun originated_contracts ->
          let result =
            Transaction_result
              {
                storage = Some storage;
                big_map_diff;
                balance_updates =
                  Delegate.cleanup_balance_updates
                    [ (Contract payer, Debited fees);
                      (Contract source, Debited amount);
                      (Contract destination, Credited amount) ];
                originated_contracts;
                consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt;
                storage_size = new_size;
                paid_storage_size_diff;
                allocated_destination_contract;
              }
          in
          return (ctxt, result, operations) )
  | Origination {delegate; script; preorigination; credit} ->
      Script.force_decode ctxt script.storage
      >>=? fun (unparsed_storage, ctxt) ->
      (* see [note] *)
      Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_storage))
      >>=? fun ctxt ->
      Script.force_decode ctxt script.code
      >>=? fun (unparsed_code, ctxt) ->
      (* see [note] *)
      Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_code))
      >>=? fun ctxt ->
      Script_ir_translator.parse_script ctxt ~legacy:false script
      >>=? fun (Ex_script parsed_script, ctxt) ->
      Script_ir_translator.collect_big_maps
        ctxt
        parsed_script.storage_type
        parsed_script.storage
      >>=? fun (to_duplicate, ctxt) ->
      let to_update = Script_ir_translator.no_big_map_id in
      Script_ir_translator.extract_big_map_diff
        ctxt
        Optimized
        parsed_script.storage_type
        parsed_script.storage
        ~to_duplicate
        ~to_update
        ~temporary:false
      >>=? fun (storage, big_map_diff, ctxt) ->
      Script_ir_translator.unparse_data
        ctxt
        Optimized
        parsed_script.storage_type
        storage
      >>=? fun (storage, ctxt) ->
      let storage = Script.lazy_expr (Micheline.strip_locations storage) in
      let script = {script with storage} in
      Contract.spend ctxt source credit
      >>=? fun ctxt ->
      ( match preorigination with
      | Some contract ->
          assert internal ;
          (* The preorigination field is only used to early return
                 the address of an originated contract in Michelson.
                 It cannot come from the outside. *)
          return (ctxt, contract)
      | None ->
          Contract.fresh_contract_from_current_nonce ctxt )
      >>=? fun (ctxt, contract) ->
      Contract.originate
        ctxt
        contract
        ~delegate
        ~balance:credit
        ~script:(script, big_map_diff)
      >>=? fun ctxt ->
      Fees.origination_burn ctxt
      >>=? fun (ctxt, origination_burn) ->
      Fees.record_paid_storage_space ctxt contract
      >>=? fun (ctxt, size, paid_storage_size_diff, fees) ->
      let result =
        Origination_result
          {
            big_map_diff;
            balance_updates =
              Delegate.cleanup_balance_updates
                [ (Contract payer, Debited fees);
                  (Contract payer, Debited origination_burn);
                  (Contract source, Debited credit);
                  (Contract contract, Credited credit) ];
            originated_contracts = [contract];
            consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt;
            storage_size = size;
            paid_storage_size_diff;
          }
      in
      return (ctxt, result, [])
  | Delegation delegate ->
      Delegate.set ctxt source delegate
      >>=? fun ctxt ->
      return
        ( ctxt,
          Delegation_result
            {consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt},
          [] )

let apply_internal_manager_operations ctxt mode ~payer ~chain_id ops =
  let rec apply ctxt applied worklist =
    match worklist with
    | [] ->
        Lwt.return (`Success ctxt, List.rev applied)
    | Internal_operation ({source; operation; nonce} as op) :: rest -> (
        ( if internal_nonce_already_recorded ctxt nonce then
          fail (Internal_operation_replay (Internal_operation op))
        else
          let ctxt = record_internal_nonce ctxt nonce in
          apply_manager_operation_content
            ctxt
            mode
            ~source
            ~payer
            ~chain_id
            ~internal:true
            operation )
        >>= function
        | Error errors ->
            let result =
              Internal_operation_result
                (op, Failed (manager_kind op.operation, errors))
            in
            let skipped =
              List.rev_map
                (fun (Internal_operation op) ->
                  Internal_operation_result
                    (op, Skipped (manager_kind op.operation)))
                rest
            in
            Lwt.return (`Failure, List.rev (skipped @ (result :: applied)))
        | Ok (ctxt, result, emitted) ->
            apply
              ctxt
              (Internal_operation_result (op, Applied result) :: applied)
              (rest @ emitted) )
  in
  apply ctxt [] ops

let precheck_manager_contents (type kind) ctxt chain_id raw_operation
    (op : kind Kind.manager contents) : context tzresult Lwt.t =
  let (Manager_operation
        {source; fee; counter; operation; gas_limit; storage_limit}) =
    op
  in
  Lwt.return (Gas.check_limit ctxt gas_limit)
  >>=? fun () ->
  let ctxt = Gas.set_limit ctxt gas_limit in
  Lwt.return (Fees.check_storage_limit ctxt storage_limit)
  >>=? fun () ->
  Contract.must_be_allocated ctxt (Contract.implicit_contract source)
  >>=? fun () ->
  Contract.check_counter_increment ctxt source counter
  >>=? fun () ->
  ( match operation with
  | Reveal pk ->
      Contract.reveal_manager_key ctxt source pk
  | Transaction {parameters; _} ->
      (* Fail quickly if not enough gas for minimal deserialization cost *)
      Lwt.return
      @@ record_trace Gas_quota_exceeded_init_deserialize
      @@ Gas.check_enough ctxt (Script.minimal_deserialize_cost parameters)
      >>=? fun () ->
      (* Fail if not enough gas for complete deserialization cost *)
      trace Gas_quota_exceeded_init_deserialize
      @@ Script.force_decode ctxt parameters
      >>|? fun (_arg, ctxt) -> ctxt
  | Origination {script; _} ->
      (* Fail quickly if not enough gas for minimal deserialization cost *)
      Lwt.return
      @@ record_trace Gas_quota_exceeded_init_deserialize
      @@ ( Gas.consume ctxt (Script.minimal_deserialize_cost script.code)
         >>? fun ctxt ->
         Gas.check_enough ctxt (Script.minimal_deserialize_cost script.storage)
         )
      >>=? fun () ->
      (* Fail if not enough gas for complete deserialization cost *)
      trace Gas_quota_exceeded_init_deserialize
      @@ Script.force_decode ctxt script.code
      >>=? fun (_code, ctxt) ->
      trace Gas_quota_exceeded_init_deserialize
      @@ Script.force_decode ctxt script.storage
      >>|? fun (_storage, ctxt) -> ctxt
  | _ ->
      return ctxt )
  >>=? fun ctxt ->
  Contract.get_manager_key ctxt source
  >>=? fun public_key ->
  (* Currently, the `raw_operation` only contains one signature, so
     all operations are required to be from the same manager. This may
     change in the future, allowing several managers to group-sign a
     sequence of transactions.  *)
  Operation.check_signature public_key chain_id raw_operation
  >>=? fun () ->
  Contract.increment_counter ctxt source
  >>=? fun ctxt ->
  Contract.spend ctxt (Contract.implicit_contract source) fee
  >>=? fun ctxt -> add_fees ctxt fee >>=? fun ctxt -> return ctxt

let apply_manager_contents (type kind) ctxt mode chain_id
    (op : kind Kind.manager contents) :
    ( [`Success of context | `Failure]
    * kind manager_operation_result
    * packed_internal_operation_result list )
    Lwt.t =
  let (Manager_operation {source; operation; gas_limit; storage_limit}) = op in
  let ctxt = Gas.set_limit ctxt gas_limit in
  let ctxt = Fees.start_counting_storage_fees ctxt in
  let source = Contract.implicit_contract source in
  apply_manager_operation_content
    ctxt
    mode
    ~source
    ~payer:source
    ~internal:false
    ~chain_id
    operation
  >>= function
  | Ok (ctxt, operation_results, internal_operations) -> (
      apply_internal_manager_operations
        ctxt
        mode
        ~payer:source
        ~chain_id
        internal_operations
      >>= function
      | (`Success ctxt, internal_operations_results) -> (
          Fees.burn_storage_fees ctxt ~storage_limit ~payer:source
          >>= function
          | Ok ctxt ->
              Lwt.return
                ( `Success ctxt,
                  Applied operation_results,
                  internal_operations_results )
          | Error errors ->
              Lwt.return
                ( `Failure,
                  Backtracked (operation_results, Some errors),
                  internal_operations_results ) )
      | (`Failure, internal_operations_results) ->
          Lwt.return
            (`Failure, Applied operation_results, internal_operations_results)
      )
  | Error errors ->
      Lwt.return (`Failure, Failed (manager_kind operation, errors), [])

let skipped_operation_result :
    type kind. kind manager_operation -> kind manager_operation_result =
  function
  | operation -> (
    match operation with
    | Reveal _ ->
        Applied
          ( Reveal_result {consumed_gas = Z.zero}
            : kind successful_manager_operation_result )
    | _ ->
        Skipped (manager_kind operation) )

let rec mark_skipped :
    type kind.
    baker:Signature.Public_key_hash.t ->
    Level.t ->
    kind Kind.manager contents_list ->
    kind Kind.manager contents_result_list =
 fun ~baker level -> function
  | Single (Manager_operation {source; fee; operation}) ->
      let source = Contract.implicit_contract source in
      Single_result
        (Manager_operation_result
           {
             balance_updates =
               Delegate.cleanup_balance_updates
                 [ (Contract source, Debited fee);
                   (Fees (baker, level.cycle), Credited fee) ];
             operation_result = skipped_operation_result operation;
             internal_operation_results = [];
           })
  | Cons (Manager_operation {source; fee; operation}, rest) ->
      let source = Contract.implicit_contract source in
      Cons_result
        ( Manager_operation_result
            {
              balance_updates =
                Delegate.cleanup_balance_updates
                  [ (Contract source, Debited fee);
                    (Fees (baker, level.cycle), Credited fee) ];
              operation_result = skipped_operation_result operation;
              internal_operation_results = [];
            },
          mark_skipped ~baker level rest )

let rec precheck_manager_contents_list :
    type kind.
    Alpha_context.t ->
    Chain_id.t ->
    _ Operation.t ->
    kind Kind.manager contents_list ->
    context tzresult Lwt.t =
 fun ctxt chain_id raw_operation contents_list ->
  match contents_list with
  | Single (Manager_operation _ as op) ->
      precheck_manager_contents ctxt chain_id raw_operation op
  | Cons ((Manager_operation _ as op), rest) ->
      precheck_manager_contents ctxt chain_id raw_operation op
      >>=? fun ctxt ->
      precheck_manager_contents_list ctxt chain_id raw_operation rest

let rec apply_manager_contents_list_rec :
    type kind.
    Alpha_context.t ->
    Script_ir_translator.unparsing_mode ->
    public_key_hash ->
    Chain_id.t ->
    kind Kind.manager contents_list ->
    ([`Success of context | `Failure] * kind Kind.manager contents_result_list)
    Lwt.t =
 fun ctxt mode baker chain_id contents_list ->
  let level = Level.current ctxt in
  match contents_list with
  | Single (Manager_operation {source; fee; _} as op) ->
      let source = Contract.implicit_contract source in
      apply_manager_contents ctxt mode chain_id op
      >>= fun (ctxt_result, operation_result, internal_operation_results) ->
      let result =
        Manager_operation_result
          {
            balance_updates =
              Delegate.cleanup_balance_updates
                [ (Contract source, Debited fee);
                  (Fees (baker, level.cycle), Credited fee) ];
            operation_result;
            internal_operation_results;
          }
      in
      Lwt.return (ctxt_result, Single_result result)
  | Cons ((Manager_operation {source; fee; _} as op), rest) -> (
      let source = Contract.implicit_contract source in
      apply_manager_contents ctxt mode chain_id op
      >>= function
      | (`Failure, operation_result, internal_operation_results) ->
          let result =
            Manager_operation_result
              {
                balance_updates =
                  Delegate.cleanup_balance_updates
                    [ (Contract source, Debited fee);
                      (Fees (baker, level.cycle), Credited fee) ];
                operation_result;
                internal_operation_results;
              }
          in
          Lwt.return
            (`Failure, Cons_result (result, mark_skipped ~baker level rest))
      | (`Success ctxt, operation_result, internal_operation_results) ->
          let result =
            Manager_operation_result
              {
                balance_updates =
                  Delegate.cleanup_balance_updates
                    [ (Contract source, Debited fee);
                      (Fees (baker, level.cycle), Credited fee) ];
                operation_result;
                internal_operation_results;
              }
          in
          apply_manager_contents_list_rec ctxt mode baker chain_id rest
          >>= fun (ctxt_result, results) ->
          Lwt.return (ctxt_result, Cons_result (result, results)) )

let mark_backtracked results =
  let rec mark_contents_list :
      type kind.
      kind Kind.manager contents_result_list ->
      kind Kind.manager contents_result_list = function
    | Single_result (Manager_operation_result op) ->
        Single_result
          (Manager_operation_result
             {
               balance_updates = op.balance_updates;
               operation_result =
                 mark_manager_operation_result op.operation_result;
               internal_operation_results =
                 List.map
                   mark_internal_operation_results
                   op.internal_operation_results;
             })
    | Cons_result (Manager_operation_result op, rest) ->
        Cons_result
          ( Manager_operation_result
              {
                balance_updates = op.balance_updates;
                operation_result =
                  mark_manager_operation_result op.operation_result;
                internal_operation_results =
                  List.map
                    mark_internal_operation_results
                    op.internal_operation_results;
              },
            mark_contents_list rest )
  and mark_internal_operation_results
      (Internal_operation_result (kind, result)) =
    Internal_operation_result (kind, mark_manager_operation_result result)
  and mark_manager_operation_result :
      type kind. kind manager_operation_result -> kind manager_operation_result
      = function
    | (Failed _ | Skipped _ | Backtracked _) as result ->
        result
    | Applied (Reveal_result _) as result ->
        result
    | Applied result ->
        Backtracked (result, None)
  in
  mark_contents_list results

let apply_manager_contents_list ctxt mode baker chain_id contents_list =
  apply_manager_contents_list_rec ctxt mode baker chain_id contents_list
  >>= fun (ctxt_result, results) ->
  match ctxt_result with
  | `Failure ->
      Lwt.return (ctxt (* backtracked *), mark_backtracked results)
  | `Success ctxt ->
      Big_map.cleanup_temporary ctxt >>= fun ctxt -> Lwt.return (ctxt, results)

let apply_contents_list (type kind) ctxt chain_id mode pred_block baker
    (operation : kind operation) (contents_list : kind contents_list) :
    (context * kind contents_result_list) tzresult Lwt.t =
  match contents_list with
  | Single (Endorsement {level}) ->
      let block = operation.shell.branch in
      fail_unless
        (Block_hash.equal block pred_block)
        (Wrong_endorsement_predecessor (pred_block, block))
      >>=? fun () ->
      let current_level = (Level.current ctxt).level in
      fail_unless
        Raw_level.(succ level = current_level)
        Invalid_endorsement_level
      >>=? fun () ->
      Baking.check_endorsement_rights ctxt chain_id operation
      >>=? fun (delegate, slots, used) ->
      if used then fail (Duplicate_endorsement delegate)
      else
        let ctxt = record_endorsement ctxt delegate in
        let gap = List.length slots in
        Lwt.return
          Tez.(Constants.endorsement_security_deposit ctxt *? Int64.of_int gap)
        >>=? fun deposit ->
        Delegate.freeze_deposit ctxt delegate deposit
        >>=? fun ctxt ->
        Global.get_block_priority ctxt
        >>=? fun block_priority ->
        Baking.endorsing_reward ctxt ~block_priority gap
        >>=? fun reward ->
        Delegate.freeze_rewards ctxt delegate reward
        >>=? fun ctxt ->
        let level = Level.from_raw ctxt level in
        return
          ( ctxt,
            Single_result
              (Endorsement_result
                 {
                   balance_updates =
                     Delegate.cleanup_balance_updates
                       [ ( Contract (Contract.implicit_contract delegate),
                           Debited deposit );
                         (Deposits (delegate, level.cycle), Credited deposit);
                         (Rewards (delegate, level.cycle), Credited reward) ];
                   delegate;
                   slots;
                 }) )
  | Single (Seed_nonce_revelation {level; nonce}) ->
      let level = Level.from_raw ctxt level in
      Nonce.reveal ctxt level nonce
      >>=? fun ctxt ->
      let seed_nonce_revelation_tip =
        Constants.seed_nonce_revelation_tip ctxt
      in
      add_rewards ctxt seed_nonce_revelation_tip
      >>=? fun ctxt ->
      return
        ( ctxt,
          Single_result
            (Seed_nonce_revelation_result
               [ ( Rewards (baker, level.cycle),
                   Credited seed_nonce_revelation_tip ) ]) )
  | Single (Double_endorsement_evidence {op1; op2}) -> (
    match (op1.protocol_data.contents, op2.protocol_data.contents) with
    | (Single (Endorsement e1), Single (Endorsement e2))
      when Raw_level.(e1.level = e2.level)
           && not (Block_hash.equal op1.shell.branch op2.shell.branch) ->
        let level = Level.from_raw ctxt e1.level in
        let oldest_level = Level.last_allowed_fork_level ctxt in
        fail_unless
          Level.(level < Level.current ctxt)
          (Too_early_double_endorsement_evidence
             {level = level.level; current = (Level.current ctxt).level})
        >>=? fun () ->
        fail_unless
          Raw_level.(oldest_level <= level.level)
          (Outdated_double_endorsement_evidence
             {level = level.level; last = oldest_level})
        >>=? fun () ->
        Baking.check_endorsement_rights ctxt chain_id op1
        >>=? fun (delegate1, _, _) ->
        Baking.check_endorsement_rights ctxt chain_id op2
        >>=? fun (delegate2, _, _) ->
        fail_unless
          (Signature.Public_key_hash.equal delegate1 delegate2)
          (Inconsistent_double_endorsement_evidence {delegate1; delegate2})
        >>=? fun () ->
        Delegate.has_frozen_balance ctxt delegate1 level.cycle
        >>=? fun valid ->
        fail_unless valid Unrequired_double_endorsement_evidence
        >>=? fun () ->
        Delegate.punish ctxt delegate1 level.cycle
        >>=? fun (ctxt, balance) ->
        Lwt.return Tez.(balance.deposit +? balance.fees)
        >>=? fun burned ->
        let reward =
          match Tez.(burned /? 2L) with Ok v -> v | Error _ -> Tez.zero
        in
        add_rewards ctxt reward
        >>=? fun ctxt ->
        let current_cycle = (Level.current ctxt).cycle in
        return
          ( ctxt,
            Single_result
              (Double_endorsement_evidence_result
                 (Delegate.cleanup_balance_updates
                    [ ( Deposits (delegate1, level.cycle),
                        Debited balance.deposit );
                      (Fees (delegate1, level.cycle), Debited balance.fees);
                      ( Rewards (delegate1, level.cycle),
                        Debited balance.rewards );
                      (Rewards (baker, current_cycle), Credited reward) ])) )
    | (_, _) ->
        fail Invalid_double_endorsement_evidence )
  | Single (Double_baking_evidence {bh1; bh2}) ->
      let hash1 = Block_header.hash bh1 in
      let hash2 = Block_header.hash bh2 in
      fail_unless
        ( Compare.Int32.(bh1.shell.level = bh2.shell.level)
        && not (Block_hash.equal hash1 hash2) )
        (Invalid_double_baking_evidence
           {hash1; level1 = bh1.shell.level; hash2; level2 = bh2.shell.level})
      >>=? fun () ->
      Lwt.return (Raw_level.of_int32 bh1.shell.level)
      >>=? fun raw_level ->
      let oldest_level = Level.last_allowed_fork_level ctxt in
      fail_unless
        Raw_level.(raw_level < (Level.current ctxt).level)
        (Too_early_double_baking_evidence
           {level = raw_level; current = (Level.current ctxt).level})
      >>=? fun () ->
      fail_unless
        Raw_level.(oldest_level <= raw_level)
        (Outdated_double_baking_evidence
           {level = raw_level; last = oldest_level})
      >>=? fun () ->
      let level = Level.from_raw ctxt raw_level in
      Roll.baking_rights_owner
        ctxt
        level
        ~priority:bh1.protocol_data.contents.priority
      >>=? fun delegate1 ->
      Baking.check_signature bh1 chain_id delegate1
      >>=? fun () ->
      Roll.baking_rights_owner
        ctxt
        level
        ~priority:bh2.protocol_data.contents.priority
      >>=? fun delegate2 ->
      Baking.check_signature bh2 chain_id delegate2
      >>=? fun () ->
      fail_unless
        (Signature.Public_key.equal delegate1 delegate2)
        (Inconsistent_double_baking_evidence
           {
             delegate1 = Signature.Public_key.hash delegate1;
             delegate2 = Signature.Public_key.hash delegate2;
           })
      >>=? fun () ->
      let delegate = Signature.Public_key.hash delegate1 in
      Delegate.has_frozen_balance ctxt delegate level.cycle
      >>=? fun valid ->
      fail_unless valid Unrequired_double_baking_evidence
      >>=? fun () ->
      Delegate.punish ctxt delegate level.cycle
      >>=? fun (ctxt, balance) ->
      Lwt.return Tez.(balance.deposit +? balance.fees)
      >>=? fun burned ->
      let reward =
        match Tez.(burned /? 2L) with Ok v -> v | Error _ -> Tez.zero
      in
      add_rewards ctxt reward
      >>=? fun ctxt ->
      let current_cycle = (Level.current ctxt).cycle in
      return
        ( ctxt,
          Single_result
            (Double_baking_evidence_result
               (Delegate.cleanup_balance_updates
                  [ (Deposits (delegate, level.cycle), Debited balance.deposit);
                    (Fees (delegate, level.cycle), Debited balance.fees);
                    (Rewards (delegate, level.cycle), Debited balance.rewards);
                    (Rewards (baker, current_cycle), Credited reward) ])) )
  | Single (Activate_account {id = pkh; activation_code}) -> (
      let blinded_pkh =
        Blinded_public_key_hash.of_ed25519_pkh activation_code pkh
      in
      Commitment.get_opt ctxt blinded_pkh
      >>=? function
      | None ->
          fail (Invalid_activation {pkh})
      | Some amount ->
          Commitment.delete ctxt blinded_pkh
          >>=? fun ctxt ->
          let contract = Contract.implicit_contract (Signature.Ed25519 pkh) in
          Contract.(credit ctxt contract amount)
          >>=? fun ctxt ->
          return
            ( ctxt,
              Single_result
                (Activate_account_result [(Contract contract, Credited amount)])
            ) )
  | Single (Proposals {source; period; proposals}) ->
      Roll.delegate_pubkey ctxt source
      >>=? fun delegate ->
      Operation.check_signature delegate chain_id operation
      >>=? fun () ->
      let level = Level.current ctxt in
      fail_unless
        Voting_period.(level.voting_period = period)
        (Wrong_voting_period (level.voting_period, period))
      >>=? fun () ->
      Amendment.record_proposals ctxt source proposals
      >>=? fun ctxt -> return (ctxt, Single_result Proposals_result)
  | Single (Ballot {source; period; proposal; ballot}) ->
      Roll.delegate_pubkey ctxt source
      >>=? fun delegate ->
      Operation.check_signature delegate chain_id operation
      >>=? fun () ->
      let level = Level.current ctxt in
      fail_unless
        Voting_period.(level.voting_period = period)
        (Wrong_voting_period (level.voting_period, period))
      >>=? fun () ->
      Amendment.record_ballot ctxt source proposal ballot
      >>=? fun ctxt -> return (ctxt, Single_result Ballot_result)
  | Single (Manager_operation _) as op ->
      precheck_manager_contents_list ctxt chain_id operation op
      >>=? fun ctxt ->
      apply_manager_contents_list ctxt mode baker chain_id op
      >>= fun (ctxt, result) -> return (ctxt, result)
  | Cons (Manager_operation _, _) as op ->
      precheck_manager_contents_list ctxt chain_id operation op
      >>=? fun ctxt ->
      apply_manager_contents_list ctxt mode baker chain_id op
      >>= fun (ctxt, result) -> return (ctxt, result)

let apply_operation ctxt chain_id mode pred_block baker hash operation =
  let ctxt = Contract.init_origination_nonce ctxt hash in
  apply_contents_list
    ctxt
    chain_id
    mode
    pred_block
    baker
    operation
    operation.protocol_data.contents
  >>=? fun (ctxt, result) ->
  let ctxt = Gas.set_unlimited ctxt in
  let ctxt = Contract.unset_origination_nonce ctxt in
  return (ctxt, {contents = result})

let may_snapshot_roll ctxt =
  let level = Alpha_context.Level.current ctxt in
  let blocks_per_roll_snapshot = Constants.blocks_per_roll_snapshot ctxt in
  if
    Compare.Int32.equal
      (Int32.rem level.cycle_position blocks_per_roll_snapshot)
      (Int32.pred blocks_per_roll_snapshot)
  then Alpha_context.Roll.snapshot_rolls ctxt >>=? fun ctxt -> return ctxt
  else return ctxt

let may_start_new_cycle ctxt =
  Baking.dawn_of_a_new_cycle ctxt
  >>=? function
  | None ->
      return (ctxt, [], [])
  | Some last_cycle ->
      Seed.cycle_end ctxt last_cycle
      >>=? fun (ctxt, unrevealed) ->
      Roll.cycle_end ctxt last_cycle
      >>=? fun ctxt ->
      Delegate.cycle_end ctxt last_cycle unrevealed
      >>=? fun (ctxt, update_balances, deactivated) ->
      Bootstrap.cycle_end ctxt last_cycle
      >>=? fun ctxt -> return (ctxt, update_balances, deactivated)

let begin_full_construction ctxt pred_timestamp protocol_data =
  Alpha_context.Global.set_block_priority
    ctxt
    protocol_data.Block_header.priority
  >>=? fun ctxt ->
  Baking.check_baking_rights ctxt protocol_data pred_timestamp
  >>=? fun (delegate_pk, block_delay) ->
  let ctxt = Fitness.increase ctxt in
  match Level.pred ctxt (Level.current ctxt) with
  | None ->
      assert false (* genesis *)
  | Some pred_level ->
      Baking.endorsement_rights ctxt pred_level
      >>=? fun rights ->
      let ctxt = init_endorsements ctxt rights in
      return (ctxt, protocol_data, delegate_pk, block_delay)

let begin_partial_construction ctxt =
  let ctxt = Fitness.increase ctxt in
  match Level.pred ctxt (Level.current ctxt) with
  | None ->
      assert false (* genesis *)
  | Some pred_level ->
      Baking.endorsement_rights ctxt pred_level
      >>=? fun rights ->
      let ctxt = init_endorsements ctxt rights in
      return ctxt

let begin_application ctxt chain_id block_header pred_timestamp =
  Alpha_context.Global.set_block_priority
    ctxt
    block_header.Block_header.protocol_data.contents.priority
  >>=? fun ctxt ->
  let current_level = Alpha_context.Level.current ctxt in
  Baking.check_proof_of_work_stamp ctxt block_header
  >>=? fun () ->
  Baking.check_fitness_gap ctxt block_header
  >>=? fun () ->
  Baking.check_baking_rights
    ctxt
    block_header.protocol_data.contents
    pred_timestamp
  >>=? fun (delegate_pk, block_delay) ->
  Baking.check_signature block_header chain_id delegate_pk
  >>=? fun () ->
  let has_commitment =
    match block_header.protocol_data.contents.seed_nonce_hash with
    | None ->
        false
    | Some _ ->
        true
  in
  fail_unless
    Compare.Bool.(has_commitment = current_level.expected_commitment)
    (Invalid_commitment {expected = current_level.expected_commitment})
  >>=? fun () ->
  let ctxt = Fitness.increase ctxt in
  match Level.pred ctxt (Level.current ctxt) with
  | None ->
      assert false (* genesis *)
  | Some pred_level ->
      Baking.endorsement_rights ctxt pred_level
      >>=? fun rights ->
      let ctxt = init_endorsements ctxt rights in
      return (ctxt, delegate_pk, block_delay)

let check_minimum_endorsements ctxt protocol_data block_delay
    included_endorsements =
  let minimum = Baking.minimum_allowed_endorsements ctxt ~block_delay in
  let timestamp = Timestamp.current ctxt in
  fail_unless
    Compare.Int.(included_endorsements >= minimum)
    (Not_enough_endorsements_for_priority
       {
         required = minimum;
         priority = protocol_data.Block_header.priority;
         endorsements = included_endorsements;
         timestamp;
       })

let finalize_application ctxt protocol_data delegate ~block_delay =
  let included_endorsements = included_endorsements ctxt in
  check_minimum_endorsements
    ctxt
    protocol_data
    block_delay
    included_endorsements
  >>=? fun () ->
  let deposit = Constants.block_security_deposit ctxt in
  add_deposit ctxt delegate deposit
  >>=? fun ctxt ->
  Baking.baking_reward
    ctxt
    ~block_priority:protocol_data.priority
    ~included_endorsements
  >>=? fun reward ->
  add_rewards ctxt reward
  >>=? fun ctxt ->
  Signature.Public_key_hash.Map.fold
    (fun delegate deposit ctxt ->
      ctxt >>=? fun ctxt -> Delegate.freeze_deposit ctxt delegate deposit)
    (get_deposits ctxt)
    (return ctxt)
  >>=? fun ctxt ->
  (* end of level (from this point nothing should fail) *)
  let fees = Alpha_context.get_fees ctxt in
  Delegate.freeze_fees ctxt delegate fees
  >>=? fun ctxt ->
  let rewards = Alpha_context.get_rewards ctxt in
  Delegate.freeze_rewards ctxt delegate rewards
  >>=? fun ctxt ->
  ( match protocol_data.Block_header.seed_nonce_hash with
  | None ->
      return ctxt
  | Some nonce_hash ->
      Nonce.record_hash ctxt {nonce_hash; delegate; rewards; fees} )
  >>=? fun ctxt ->
  (* end of cycle *)
  may_snapshot_roll ctxt
  >>=? fun ctxt ->
  may_start_new_cycle ctxt
  >>=? fun (ctxt, balance_updates, deactivated) ->
  Amendment.may_start_new_voting_period ctxt
  >>=? fun ctxt ->
  let cycle = (Level.current ctxt).cycle in
  let balance_updates =
    Delegate.(
      cleanup_balance_updates
        ( [ (Contract (Contract.implicit_contract delegate), Debited deposit);
            (Deposits (delegate, cycle), Credited deposit);
            (Rewards (delegate, cycle), Credited reward) ]
        @ balance_updates ))
  in
  let consumed_gas =
    Z.sub
      (Constants.hard_gas_limit_per_block ctxt)
      (Alpha_context.Gas.block_level ctxt)
  in
  Alpha_context.Vote.get_current_period_kind ctxt
  >>=? fun voting_period_kind ->
  let receipt =
    Apply_results.
      {
        baker = delegate;
        level = Level.current ctxt;
        voting_period_kind;
        nonce_hash = protocol_data.seed_nonce_hash;
        consumed_gas;
        deactivated;
        balance_updates;
      }
  in
  return (ctxt, receipt)
apply_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "operation.wrong_endorsement_predecessor" % string
      "Wrong endorsement predecessor" % string
      "Trying to include an endorsement in a block that is not the successor of the endorsed one"
        % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(e, p) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Wrong predecessor " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      ", expected " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))))
                "Wrong predecessor %a, expected %a" % string)
              Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.pp)
              p
              Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.pp)
              e))
      (obj2
        (req None None "expected" % string
          Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.encoding))
        (req None None "provided" % string
          Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.encoding)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_endorsement_predecessor
            e p => Some (e, p)
        | _ => None
        end)
      (fun function_parameter =>
        let '(e, p) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_endorsement_predecessor
          e p) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "operation.wrong_voting_period" % string
      "Wrong voting period" % string
      "Trying to onclude a proposal or ballot meant for another voting period" %
        string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(e, p) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Wrong voting period " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      ", current is " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))))
                "Wrong voting period %a, current is %a" % string)
              Voting_period.pp p Voting_period.pp e))
      (obj2 (req None None "current" % string Voting_period.encoding)
        (req None None "provided" % string Voting_period.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_voting_period
            e p => Some (e, p)
        | _ => None
        end)
      (fun function_parameter =>
        let '(e, p) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_voting_period
          e p) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "operation.duplicate_endorsement" % string
      "Duplicate endorsement" % string
      "Two endorsements received from same delegate" % string
      (Some
        (fun ppf =>
          fun k =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Duplicate endorsement from delegate " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " (possible replay attack)." % string
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Duplicate endorsement from delegate %a (possible replay attack)."
                  % string) Signature.Public_key_hash.pp_short k))
      (obj1
        (req None None "delegate" % string Signature.Public_key_hash.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_endorsement
            k => Some k
        | _ => None
        end)
      (fun k =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_endorsement
          k) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "operation.invalid_endorsement_level" % string
      "Unexpected level in endorsement" % string
      "The level of an endorsement is inconsistent with the  provided block hash."
        % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Unexpected level in endorsement." % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Unexpected level in endorsement." % string)))
      Data_encoding.unit
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_endorsement_level
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_endorsement_level)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.invalid_commitment" % string
      "Invalid commitment in block header" % string
      "The block header has invalid commitment." % string
      (Some
        (fun ppf =>
          fun expected =>
            if expected then
              Format.fprintf ppf
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    "Missing seed's nonce commitment in block header." % string
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                  "Missing seed's nonce commitment in block header." % string)
            else
              Format.fprintf ppf
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    "Unexpected seed's nonce commitment in block header." %
                      string
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                  "Unexpected seed's nonce commitment in block header." % string)))
      (obj1 (req None None "expected" % string bool))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_commitment
            {| expected := expected |} => Some expected
        | _ => None
        end)
      (fun expected =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_commitment
          {| expected := expected |}) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "internal_operation_replay" % string
      "Internal operation replay" % string
      "An internal operation was emitted twice by a script" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let
              'Tezos_raw_protocol_alpha.Alpha_context.Internal_operation {|
                nonce := nonce |} := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Internal operation " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " was emitted twice by a script" % string
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Internal operation %d was emitted twice by a script" % string)
              nonce)) Operation.internal_operation_encoding
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Internal_operation_replay
            op => Some op
        | _ => None
        end)
      (fun op =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Internal_operation_replay
          op) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.invalid_double_endorsement_evidence" % string
      "Invalid double endorsement evidence" % string
      "A double-endorsement evidence is malformed" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Malformed double-endorsement evidence" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Malformed double-endorsement evidence" % string)))
      Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_double_endorsement_evidence
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_double_endorsement_evidence)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.inconsistent_double_endorsement_evidence" % string
      "Inconsistent double endorsement evidence" % string
      "A double-endorsement evidence is inconsistent  (two distinct delegates)"
        % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(delegate1, delegate2) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Inconsistent double-endorsement evidence  (distinct delegate: "
                    % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " and " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          ")" % char
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "Inconsistent double-endorsement evidence  (distinct delegate: %a and %a)"
                  % string) Signature.Public_key_hash.pp_short delegate1
              Signature.Public_key_hash.pp_short delegate2))
      (obj2
        (req None None "delegate1" % string Signature.Public_key_hash.encoding)
        (req None None "delegate2" % string Signature.Public_key_hash.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_double_endorsement_evidence
            {| delegate1 := delegate1; delegate2 := delegate2 |} =>
          Some (delegate1, delegate2)
        | _ => None
        end)
      (fun function_parameter =>
        let '(delegate1, delegate2) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_double_endorsement_evidence
          {| delegate1 := delegate1; delegate2 := delegate2 |}) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.unrequired_double_endorsement_evidence" % string
      "Unrequired double endorsement evidence" % string
      "A double-endorsement evidence is unrequired" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "A valid double-endorsement operation cannot  be applied: the associated delegate  has previously been denunciated in this cycle."
                    % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "A valid double-endorsement operation cannot  be applied: the associated delegate  has previously been denunciated in this cycle."
                  % string))) Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unrequired_double_endorsement_evidence
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unrequired_double_endorsement_evidence)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.too_early_double_endorsement_evidence" % string
      "Too early double endorsement evidence" % string
      "A double-endorsement evidence is in the future" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(level, current) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "A double-endorsement evidence is in the future  (current level: "
                    % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      ", endorsement level: " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          ")" % char
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "A double-endorsement evidence is in the future  (current level: %a, endorsement level: %a)"
                  % string) Raw_level.pp current Raw_level.pp level))
      (obj2 (req None None "level" % string Raw_level.encoding)
        (req None None "current" % string Raw_level.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_double_endorsement_evidence
            {| level := level; current := current |} => Some (level, current)
        | _ => None
        end)
      (fun function_parameter =>
        let '(level, current) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_double_endorsement_evidence
          {| level := level; current := current |}) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.outdated_double_endorsement_evidence" % string
      "Outdated double endorsement evidence" % string
      "A double-endorsement evidence is outdated." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(level, last) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "A double-endorsement evidence is outdated  (last acceptable level: "
                    % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      ", endorsement level: " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          ")" % char
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "A double-endorsement evidence is outdated  (last acceptable level: %a, endorsement level: %a)"
                  % string) Raw_level.pp last Raw_level.pp level))
      (obj2 (req None None "level" % string Raw_level.encoding)
        (req None None "last" % string Raw_level.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Outdated_double_endorsement_evidence
            {| level := level; last := last |} => Some (level, last)
        | _ => None
        end)
      (fun function_parameter =>
        let '(level, last) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Outdated_double_endorsement_evidence
          {| level := level; last := last |}) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.invalid_double_baking_evidence" % string
      "Invalid double baking evidence" % string
      "A double-baking evidence is inconsistent  (two distinct level)" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(hash1, level1, hash2, level2) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Invalid double-baking evidence (hash: " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " and " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                          ", levels: " % string
                          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                              " and " % string
                              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
                                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                                  ")" % char
                                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))))))
                "Invalid double-baking evidence (hash: %a and %a, levels: %ld and %ld)"
                  % string)
              Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.pp)
              hash1
              Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.pp)
              hash2 level1 level2))
      (obj4
        (req None None "hash1" % string
          Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.encoding))
        (req None None "level1" % string int32)
        (req None None "hash2" % string
          Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.encoding))
        (req None None "level2" % string int32))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_double_baking_evidence
            {|
            hash1 := hash1;
              level1 := level1;
              hash2 := hash2;
              level2 := level2
              |} => Some (hash1, level1, hash2, level2)
        | _ => None
        end)
      (fun function_parameter =>
        let '(hash1, level1, hash2, level2) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_double_baking_evidence
          {| hash1 := hash1; level1 := level1; hash2 := hash2; level2 := level2
            |}) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.inconsistent_double_baking_evidence" % string
      "Inconsistent double baking evidence" % string
      "A double-baking evidence is inconsistent  (two distinct delegates)" %
        string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(delegate1, delegate2) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Inconsistent double-baking evidence  (distinct delegate: " %
                    string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " and " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          ")" % char
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "Inconsistent double-baking evidence  (distinct delegate: %a and %a)"
                  % string) Signature.Public_key_hash.pp_short delegate1
              Signature.Public_key_hash.pp_short delegate2))
      (obj2
        (req None None "delegate1" % string Signature.Public_key_hash.encoding)
        (req None None "delegate2" % string Signature.Public_key_hash.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_double_baking_evidence
            {| delegate1 := delegate1; delegate2 := delegate2 |} =>
          Some (delegate1, delegate2)
        | _ => None
        end)
      (fun function_parameter =>
        let '(delegate1, delegate2) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_double_baking_evidence
          {| delegate1 := delegate1; delegate2 := delegate2 |}) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.unrequired_double_baking_evidence" % string
      "Unrequired double baking evidence" % string
      "A double-baking evidence is unrequired" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "A valid double-baking operation cannot  be applied: the associated delegate  has previously been denunciated in this cycle."
                    % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "A valid double-baking operation cannot  be applied: the associated delegate  has previously been denunciated in this cycle."
                  % string))) Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unrequired_double_baking_evidence
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unrequired_double_baking_evidence)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.too_early_double_baking_evidence" % string
      "Too early double baking evidence" % string
      "A double-baking evidence is in the future" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(level, current) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "A double-baking evidence is in the future  (current level: "
                    % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      ", baking level: " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          ")" % char
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "A double-baking evidence is in the future  (current level: %a, baking level: %a)"
                  % string) Raw_level.pp current Raw_level.pp level))
      (obj2 (req None None "level" % string Raw_level.encoding)
        (req None None "current" % string Raw_level.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_double_baking_evidence
            {| level := level; current := current |} => Some (level, current)
        | _ => None
        end)
      (fun function_parameter =>
        let '(level, current) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_double_baking_evidence
          {| level := level; current := current |}) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.outdated_double_baking_evidence" % string
      "Outdated double baking evidence" % string
      "A double-baking evidence is outdated." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(level, last) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "A double-baking evidence is outdated  (last acceptable level: "
                    % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      ", baking level: " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          ")" % char
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "A double-baking evidence is outdated  (last acceptable level: %a, baking level: %a)"
                  % string) Raw_level.pp last Raw_level.pp level))
      (obj2 (req None None "level" % string Raw_level.encoding)
        (req None None "last" % string Raw_level.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Outdated_double_baking_evidence
            {| level := level; last := last |} => Some (level, last)
        | _ => None
        end)
      (fun function_parameter =>
        let '(level, last) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Outdated_double_baking_evidence
          {| level := level; last := last |}) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "operation.invalid_activation" % string
      "Invalid activation" % string
      "The given key and secret do not correspond to any existing preallocated contract"
        % string
      (Some
        (fun ppf =>
          fun pkh =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Invalid activation. The public key " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " does not match any commitment." % string
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Invalid activation. The public key %a does not match any commitment."
                  % string) Ed25519.Public_key_hash.pp pkh))
      (obj1 (req None None "pkh" % string Ed25519.Public_key_hash.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_activation
            {| pkh := pkh |} => Some pkh
        | _ => None
        end)
      (fun pkh =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_activation
          {| pkh := pkh |}) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "block.multiple_revelation" % string
      "Multiple revelations were included in a manager operation" % string
      "A manager operation should not contain more than one revelation" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Multiple revelations were included in a manager operation" %
                    string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Multiple revelations were included in a manager operation" %
                  string))) Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Multiple_revelation
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Multiple_revelation)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "gas_exhausted.init_deserialize" % string
      "Not enough gas for initial deserialization of script expresions" % string
      "Gas limit was not high enough to deserialize the transaction parameters or origination script code or initial storage, making the operation impossible to parse within the provided gas bounds."
        % string None Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "operation.not_enought_endorsements_for_priority" % string
    "Not enough endorsements for priority" % string
    "The block being validated does not include the required minimum number of endorsements for this priority."
      % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let '(required, endorsements, priority, timestamp) :=
            function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "Wrong number of endorsements (" % string
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_i
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    ") for priority (" % string
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_i
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                        "), " % string
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_i
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                            " are expected at " % string
                            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))))))))
              "Wrong number of endorsements (%i) for priority (%i), %i are expected at %a"
                % string) endorsements priority required Time.pp_hum timestamp))
    (obj4 (req None None "required" % string int31)
      (req None None "endorsements" % string int31)
      (req None None "priority" % string int31)
      (req None None "timestamp" % string Time.encoding))
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Not_enough_endorsements_for_priority
          {|
          required := required;
            priority := priority;
            endorsements := endorsements;
            timestamp := timestamp
            |} => Some (required, endorsements, priority, timestamp)
      | _ => None
      end)
    (fun function_parameter =>
      let '(required, endorsements, priority, timestamp) := function_parameter
        in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Not_enough_endorsements_for_priority
        {| required := required; priority := priority;
          endorsements := endorsements; timestamp := timestamp |}).

Import Apply_results.

Definition apply_manager_operation_content {kind : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.t)
  (mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
  (payer : Tezos_raw_protocol_alpha.Alpha_context.Contract.t)
  (source : Tezos_raw_protocol_alpha.Alpha_context.Contract.t)
  (chain_id :
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (internal : bool)
  (operation : Tezos_raw_protocol_alpha.Alpha_context.manager_operation kind)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.context *
        Tezos_raw_protocol_alpha.Apply_results.successful_manager_operation_result
          kind *
        list Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation)) :=
  let before_operation := ctxt in
  op_gtgteqquestion (Contract.must_exist ctxt source)
    (fun function_parameter =>
      let 'tt := function_parameter in
      op_gtgteqquestion
        (Lwt.__return
          (Gas.consume ctxt Michelson_v1_gas.Cost_of.manager_operation))
        (fun ctxt =>
          match operation with
          | Tezos_raw_protocol_alpha.Alpha_context.Reveal _ =>
            __return
              (ctxt,
                (Tezos_raw_protocol_alpha.Apply_results.Reveal_result
                  {| consumed_gas := Gas.consumed before_operation ctxt |}), [])
          |
            Tezos_raw_protocol_alpha.Alpha_context.Transaction {|
              amount := amount;
                parameters := parameters;
                entrypoint := entrypoint;
                destination := destination
                |} =>
            op_gtgteqquestion (Contract.spend ctxt source amount)
              (fun ctxt =>
                op_gtgteqquestion
                  match Contract.is_implicit destination with
                  | None => __return (ctxt, [], false)
                  | Some _ =>
                    op_gtgteqquestion (Contract.allocated ctxt destination)
                      (fun function_parameter =>
                        match function_parameter with
                        | true => __return (ctxt, [], false)
                        | false =>
                          op_gtgteqquestion (Fees.origination_burn ctxt)
                            (fun function_parameter =>
                              let '(ctxt, origination_burn) :=
                                function_parameter in
                              __return
                                (ctxt,
                                  (cons
                                    ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                      payer),
                                      (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                        origination_burn)) []), true))
                        end)
                  end
                  (fun function_parameter =>
                    let
                      '(ctxt, maybe_burn_balance_update,
                        allocated_destination_contract) := function_parameter in
                    op_gtgteqquestion (Contract.credit ctxt destination amount)
                      (fun ctxt =>
                        op_gtgteqquestion (Contract.get_script ctxt destination)
                          (fun function_parameter =>
                            let '(ctxt, script) := function_parameter in
                            match script with
                            | None =>
                              op_gtgteqquestion
                                (op_gtgteqquestion
                                  match entrypoint with
                                  | "default" % string => __return tt
                                  | entrypoint =>
                                    fail
                                      (Tezos_protocol_environment_alpha__Environment.Error_monad.No_such_entrypoint
                                        entrypoint)
                                  end
                                  (fun function_parameter =>
                                    let 'tt := function_parameter in
                                    op_gtgteqquestion
                                      (Script.force_decode ctxt parameters)
                                      (fun function_parameter =>
                                        let '(arg, ctxt) := function_parameter
                                          in
                                        let cost_arg :=
                                          Script.deserialized_cost arg in
                                        op_gtgteqquestion
                                          (Lwt.__return
                                            (Gas.consume ctxt cost_arg))
                                          (fun ctxt =>
                                            match Micheline.root arg with
                                            |
                                              Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                _
                                                Tezos_raw_protocol_alpha.Alpha_context.Script.D_Unit
                                                [] _ => __return ctxt
                                            | _ =>
                                              fail
                                                (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_contract_parameter
                                                  destination)
                                            end))))
                                (fun ctxt =>
                                  let result :=
                                    Tezos_raw_protocol_alpha.Apply_results.Transaction_result
                                      {| storage := None; big_map_diff := None;
                                        balance_updates :=
                                          Delegate.cleanup_balance_updates
                                            (op_at
                                              (cons
                                                ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                  source),
                                                  (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                    amount))
                                                (cons
                                                  ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                    destination),
                                                    (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                                                      amount)) []))
                                              maybe_burn_balance_update);
                                        originated_contracts := [];
                                        consumed_gas :=
                                          Gas.consumed before_operation ctxt;
                                        storage_size := Z.zero;
                                        paid_storage_size_diff := Z.zero;
                                        allocated_destination_contract :=
                                          allocated_destination_contract |} in
                                  __return (ctxt, result, []))
                            | Some script =>
                              op_gtgteqquestion
                                (Script.force_decode ctxt parameters)
                                (fun function_parameter =>
                                  let '(parameter, ctxt) := function_parameter
                                    in
                                  let cost_parameter :=
                                    Script.deserialized_cost parameter in
                                  op_gtgteqquestion
                                    (Lwt.__return
                                      (Gas.consume ctxt cost_parameter))
                                    (fun ctxt =>
                                      let step_constants :=
                                        {| source := source; payer := payer;
                                          self := destination; amount := amount;
                                          chain_id := chain_id |} in
                                      op_gtgteqquestion
                                        (Script_interpreter.execute ctxt mode
                                          step_constants script entrypoint
                                          parameter)
                                        (fun function_parameter =>
                                          let '{|
                                            ctxt := ctxt;
                                              storage := storage;
                                              big_map_diff := big_map_diff;
                                              operations := operations
                                              |} := function_parameter in
                                          op_gtgteqquestion
                                            (Contract.update_script_storage ctxt
                                              destination storage big_map_diff)
                                            (fun ctxt =>
                                              op_gtgteqquestion
                                                (Fees.record_paid_storage_space
                                                  ctxt destination)
                                                (fun function_parameter =>
                                                  let
                                                    '(ctxt, new_size,
                                                      paid_storage_size_diff,
                                                      fees) :=
                                                    function_parameter in
                                                  op_gtgteqquestion
                                                    (Contract.originated_from_current_nonce
                                                      before_operation ctxt)
                                                    (fun originated_contracts =>
                                                      let result :=
                                                        Tezos_raw_protocol_alpha.Apply_results.Transaction_result
                                                          {|
                                                            storage :=
                                                              Some storage;
                                                            big_map_diff :=
                                                              big_map_diff;
                                                            balance_updates :=
                                                              Delegate.cleanup_balance_updates
                                                                (cons
                                                                  ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                                    payer),
                                                                    (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                                      fees))
                                                                  (cons
                                                                    ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                                      source),
                                                                      (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                                        amount))
                                                                    (cons
                                                                      ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                                        destination),
                                                                        (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                                                                          amount))
                                                                      [])));
                                                            originated_contracts :=
                                                              originated_contracts;
                                                            consumed_gas :=
                                                              Gas.consumed
                                                                before_operation
                                                                ctxt;
                                                            storage_size :=
                                                              new_size;
                                                            paid_storage_size_diff :=
                                                              paid_storage_size_diff;
                                                            allocated_destination_contract :=
                                                              allocated_destination_contract
                                                            |} in
                                                      __return
                                                        (ctxt, result,
                                                          operations)))))))
                            end))))
          |
            Tezos_raw_protocol_alpha.Alpha_context.Origination {|
              delegate := delegate;
                script := script;
                credit := credit;
                preorigination := preorigination
                |} =>
            op_gtgteqquestion (Script.force_decode ctxt (storage script))
              (fun function_parameter =>
                let '(unparsed_storage, ctxt) := function_parameter in
                op_gtgteqquestion
                  (Lwt.__return
                    (Gas.consume ctxt
                      (Script.deserialized_cost unparsed_storage)))
                  (fun ctxt =>
                    op_gtgteqquestion (Script.force_decode ctxt (code script))
                      (fun function_parameter =>
                        let '(unparsed_code, ctxt) := function_parameter in
                        op_gtgteqquestion
                          (Lwt.__return
                            (Gas.consume ctxt
                              (Script.deserialized_cost unparsed_code)))
                          (fun ctxt =>
                            op_gtgteqquestion
                              (Script_ir_translator.parse_script None ctxt false
                                script)
                              (fun function_parameter =>
                                let
                                  '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_script
                                    parsed_script, ctxt) := function_parameter
                                  in
                                op_gtgteqquestion
                                  (Script_ir_translator.collect_big_maps ctxt
                                    (storage_type parsed_script)
                                    (storage parsed_script))
                                  (fun function_parameter =>
                                    let '(to_duplicate, ctxt) :=
                                      function_parameter in
                                    let to_update :=
                                      Script_ir_translator.no_big_map_id in
                                    op_gtgteqquestion
                                      (Script_ir_translator.extract_big_map_diff
                                        ctxt
                                        Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                                        false to_duplicate to_update
                                        (storage_type parsed_script)
                                        (storage parsed_script))
                                      (fun function_parameter =>
                                        let '(storage, big_map_diff, ctxt) :=
                                          function_parameter in
                                        op_gtgteqquestion
                                          (Script_ir_translator.unparse_data
                                            ctxt
                                            Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                                            (storage_type parsed_script) storage)
                                          (fun function_parameter =>
                                            let '(storage, ctxt) :=
                                              function_parameter in
                                            let storage :=
                                              Script.lazy_expr
                                                (Micheline.strip_locations
                                                  storage) in
                                            let script :=
                                              (* ❌ Record substitution not handled *)
                                              record_substitution in
                                            op_gtgteqquestion
                                              (Contract.spend ctxt source credit)
                                              (fun ctxt =>
                                                op_gtgteqquestion
                                                  match preorigination with
                                                  | Some contract =>
                                                    (* ❌ Sequences of instructions are not handled (operator ";") *)
                                                    let _ :=
                                                      (* ❌ Assert instruction is not handled. *)
                                                      assert internal in
                                                    __return (ctxt, contract)
                                                  | None =>
                                                    Contract.fresh_contract_from_current_nonce
                                                      ctxt
                                                  end
                                                  (fun function_parameter =>
                                                    let '(ctxt, contract) :=
                                                      function_parameter in
                                                    op_gtgteqquestion
                                                      (Contract.originate ctxt
                                                        contract credit
                                                        (script, big_map_diff)
                                                        delegate)
                                                      (fun ctxt =>
                                                        op_gtgteqquestion
                                                          (Fees.origination_burn
                                                            ctxt)
                                                          (fun
                                                            function_parameter
                                                            =>
                                                            let
                                                              '(ctxt,
                                                                origination_burn) :=
                                                              function_parameter
                                                              in
                                                            op_gtgteqquestion
                                                              (Fees.record_paid_storage_space
                                                                ctxt contract)
                                                              (fun
                                                                function_parameter
                                                                =>
                                                                let
                                                                  '(ctxt, size,
                                                                    paid_storage_size_diff,
                                                                    fees) :=
                                                                  function_parameter
                                                                  in
                                                                let result :=
                                                                  Tezos_raw_protocol_alpha.Apply_results.Origination_result
                                                                    {|
                                                                      big_map_diff :=
                                                                        big_map_diff;
                                                                      balance_updates :=
                                                                        Delegate.cleanup_balance_updates
                                                                          (cons
                                                                            ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                                              payer),
                                                                              (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                                                fees))
                                                                            (cons
                                                                              ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                                                payer),
                                                                                (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                                                  origination_burn))
                                                                              (cons
                                                                                ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                                                  source),
                                                                                  (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                                                    credit))
                                                                                (cons
                                                                                  ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                                                    contract),
                                                                                    (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                                                                                      credit))
                                                                                  []))));
                                                                      originated_contracts :=
                                                                        cons
                                                                          contract
                                                                          [];
                                                                      consumed_gas :=
                                                                        Gas.consumed
                                                                          before_operation
                                                                          ctxt;
                                                                      storage_size :=
                                                                        size;
                                                                      paid_storage_size_diff :=
                                                                        paid_storage_size_diff
                                                                      |} in
                                                                __return
                                                                  (ctxt, result,
                                                                    []))))))))))))))
          | Tezos_raw_protocol_alpha.Alpha_context.Delegation delegate =>
            op_gtgteqquestion (Delegate.set ctxt source delegate)
              (fun ctxt =>
                __return
                  (ctxt,
                    (Tezos_raw_protocol_alpha.Apply_results.Delegation_result
                      {| consumed_gas := Gas.consumed before_operation ctxt |}),
                    []))
          end)).

Definition apply_internal_manager_operations
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
  (payer : Tezos_raw_protocol_alpha.Alpha_context.Contract.t)
  (chain_id :
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (ops : list Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (variant *
      list
        Tezos_raw_protocol_alpha.Apply_results.packed_internal_operation_result) :=
  let fix apply
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (applied :
    list Tezos_raw_protocol_alpha.Apply_results.packed_internal_operation_result)
    (worklist :
    list Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (variant *
        list
          Tezos_raw_protocol_alpha.Apply_results.packed_internal_operation_result) :=
    match worklist with
    | [] =>
      Lwt.__return
        ((* ❌ Variants not supported *)
        variant, (List.rev applied))
    |
      cons
        (Tezos_raw_protocol_alpha.Alpha_context.Internal_operation
          ({| source := source; operation := operation; nonce := nonce |} as op))
        rest =>
      op_gtgteq
        (if internal_nonce_already_recorded ctxt nonce then
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Internal_operation_replay
              (Tezos_raw_protocol_alpha.Alpha_context.Internal_operation op))
        else
          let ctxt := record_internal_nonce ctxt nonce in
          apply_manager_operation_content ctxt mode payer source chain_id true
            operation)
        (fun function_parameter =>
          match function_parameter with
          |
            Tezos_protocol_environment_alpha__Environment.Pervasives.Error
              errors =>
            let result :=
              Tezos_raw_protocol_alpha.Apply_results.Internal_operation_result
                op
                (Tezos_raw_protocol_alpha.Apply_results.Failed
                  (manager_kind (operation op)) errors) in
            let skipped :=
              List.rev_map
                (fun function_parameter =>
                  let
                    'Tezos_raw_protocol_alpha.Alpha_context.Internal_operation
                      op := function_parameter in
                  Tezos_raw_protocol_alpha.Apply_results.Internal_operation_result
                    op
                    (Tezos_raw_protocol_alpha.Apply_results.Skipped
                      (manager_kind (operation op)))) rest in
            Lwt.__return
              ((* ❌ Variants not supported *)
              variant, (List.rev (op_at skipped (cons result applied))))
          |
            Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
              (ctxt, result, emitted) =>
            apply ctxt
              (cons
                (Tezos_raw_protocol_alpha.Apply_results.Internal_operation_result
                  op (Tezos_raw_protocol_alpha.Apply_results.Applied result))
                applied) (op_at rest emitted)
          end)
    end in
  apply ctxt [] ops.

Definition precheck_manager_contents {A B : Type}
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (chain_id :
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (raw_operation : Tezos_raw_protocol_alpha__Alpha_context.operation A)
  (op :
    Tezos_raw_protocol_alpha.Alpha_context.contents
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager B))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.context) :=
  let
    'Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      source := source;
        fee := fee;
        counter := counter;
        operation := operation;
        gas_limit := gas_limit;
        storage_limit := storage_limit
        |} := op in
  op_gtgteqquestion (Lwt.__return (Gas.check_limit ctxt gas_limit))
    (fun function_parameter =>
      let 'tt := function_parameter in
      let ctxt := Gas.set_limit ctxt gas_limit in
      op_gtgteqquestion
        (Lwt.__return (Fees.check_storage_limit ctxt storage_limit))
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgteqquestion
            (Contract.must_be_allocated ctxt (Contract.implicit_contract source))
            (fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteqquestion
                (Contract.check_counter_increment ctxt source counter)
                (fun function_parameter =>
                  let 'tt := function_parameter in
                  op_gtgteqquestion
                    match operation with
                    | Tezos_raw_protocol_alpha.Alpha_context.Reveal pk =>
                      Contract.reveal_manager_key ctxt source pk
                    |
                      Tezos_raw_protocol_alpha.Alpha_context.Transaction {|
                        parameters := parameters |} =>
                      op_gtgteqquestion
                        (op_atat Lwt.__return
                          (op_atat
                            (record_trace
                              Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
                            (Gas.check_enough ctxt
                              (Script.minimal_deserialize_cost parameters))))
                        (fun function_parameter =>
                          let 'tt := function_parameter in
                          op_gtgtpipequestion
                            (op_atat
                              (trace
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
                              (Script.force_decode ctxt parameters))
                            (fun function_parameter =>
                              let '(_arg, ctxt) := function_parameter in
                              ctxt))
                    |
                      Tezos_raw_protocol_alpha.Alpha_context.Origination {|
                        script := script |} =>
                      op_gtgteqquestion
                        (op_atat Lwt.__return
                          (op_atat
                            (record_trace
                              Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
                            (op_gtgtquestion
                              (Gas.consume ctxt
                                (Script.minimal_deserialize_cost (code script)))
                              (fun ctxt =>
                                Gas.check_enough ctxt
                                  (Script.minimal_deserialize_cost
                                    (storage script))))))
                        (fun function_parameter =>
                          let 'tt := function_parameter in
                          op_gtgteqquestion
                            (op_atat
                              (trace
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
                              (Script.force_decode ctxt (code script)))
                            (fun function_parameter =>
                              let '(_code, ctxt) := function_parameter in
                              op_gtgtpipequestion
                                (op_atat
                                  (trace
                                    Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
                                  (Script.force_decode ctxt (storage script)))
                                (fun function_parameter =>
                                  let '(_storage, ctxt) := function_parameter in
                                  ctxt)))
                    | _ => __return ctxt
                    end
                    (fun ctxt =>
                      op_gtgteqquestion (Contract.get_manager_key ctxt source)
                        (fun public_key =>
                          op_gtgteqquestion
                            (Operation.check_signature public_key chain_id
                              raw_operation)
                            (fun function_parameter =>
                              let 'tt := function_parameter in
                              op_gtgteqquestion
                                (Contract.increment_counter ctxt source)
                                (fun ctxt =>
                                  op_gtgteqquestion
                                    (Contract.spend ctxt
                                      (Contract.implicit_contract source) fee)
                                    (fun ctxt =>
                                      op_gtgteqquestion (add_fees ctxt fee)
                                        (fun ctxt => __return ctxt)))))))))).

Definition apply_manager_contents {A : Type}
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
  (chain_id :
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (op :
    Tezos_raw_protocol_alpha.Alpha_context.contents
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (variant * Tezos_raw_protocol_alpha.Apply_results.manager_operation_result A
      *
      list
        Tezos_raw_protocol_alpha.Apply_results.packed_internal_operation_result) :=
  let
    'Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      source := source;
        operation := operation;
        gas_limit := gas_limit;
        storage_limit := storage_limit
        |} := op in
  let ctxt := Gas.set_limit ctxt gas_limit in
  let ctxt := Fees.start_counting_storage_fees ctxt in
  let source := Contract.implicit_contract source in
  op_gtgteq
    (apply_manager_operation_content ctxt mode source source chain_id false
      operation)
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
          (ctxt, operation_results, internal_operations) =>
        op_gtgteq
          (apply_internal_manager_operations ctxt mode source chain_id
            internal_operations)
          (fun function_parameter =>
            match function_parameter with
            | (Success ctxt, internal_operations_results) =>
              op_gtgteq (Fees.burn_storage_fees ctxt storage_limit source)
                (fun function_parameter =>
                  match function_parameter with
                  |
                    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                      ctxt =>
                    Lwt.__return
                      ((* ❌ Variants not supported *)
                      variant,
                        (Tezos_raw_protocol_alpha.Apply_results.Applied
                          operation_results), internal_operations_results)
                  |
                    Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                      errors =>
                    Lwt.__return
                      ((* ❌ Variants not supported *)
                      variant,
                        (Tezos_raw_protocol_alpha.Apply_results.Backtracked
                          operation_results (Some errors)),
                        internal_operations_results)
                  end)
            | (Failure, internal_operations_results) =>
              Lwt.__return
                ((* ❌ Variants not supported *)
                variant,
                  (Tezos_raw_protocol_alpha.Apply_results.Applied
                    operation_results), internal_operations_results)
            end)
      | Tezos_protocol_environment_alpha__Environment.Pervasives.Error errors =>
        Lwt.__return
          ((* ❌ Variants not supported *)
          variant,
            (Tezos_raw_protocol_alpha.Apply_results.Failed
              (manager_kind operation) errors), [])
      end).

Definition skipped_operation_result {kind : Type}
  (operation : Tezos_raw_protocol_alpha.Alpha_context.manager_operation kind)
  : Tezos_raw_protocol_alpha.Apply_results.manager_operation_result kind :=
  match operation with
  | Tezos_raw_protocol_alpha.Alpha_context.Reveal _ =>
    Tezos_raw_protocol_alpha.Apply_results.Applied
      (Tezos_raw_protocol_alpha.Apply_results.Reveal_result
        {| consumed_gas := Z.zero |})
  | _ => Tezos_raw_protocol_alpha.Apply_results.Skipped (manager_kind operation)
  end.

Fixpoint mark_skipped {kind : Type}
  (baker :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (level : Tezos_raw_protocol_alpha.Alpha_context.Level.t)
  (function_parameter :
    Tezos_raw_protocol_alpha.Alpha_context.contents_list
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind))
  : Tezos_raw_protocol_alpha.Apply_results.contents_result_list
    (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) :=
  match function_parameter with
  |
    Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
        source := source; fee := fee; operation := operation |}) =>
    let source := Contract.implicit_contract source in
    Tezos_raw_protocol_alpha.Apply_results.Single_result
      (Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result
        {|
          balance_updates :=
            Delegate.cleanup_balance_updates
              (cons
                ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                  source),
                  (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited fee))
                (cons
                  ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Fees baker
                    (cycle level)),
                    (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                      fee)) []));
          operation_result := skipped_operation_result operation;
          internal_operation_results := [] |})
  |
    Tezos_raw_protocol_alpha.Alpha_context.Cons
      (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
        source := source; fee := fee; operation := operation |}) rest =>
    let source := Contract.implicit_contract source in
    Tezos_raw_protocol_alpha.Apply_results.Cons_result
      (Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result
        {|
          balance_updates :=
            Delegate.cleanup_balance_updates
              (cons
                ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                  source),
                  (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited fee))
                (cons
                  ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Fees baker
                    (cycle level)),
                    (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                      fee)) []));
          operation_result := skipped_operation_result operation;
          internal_operation_results := [] |}) (mark_skipped baker level rest)
  end.

Fixpoint precheck_manager_contents_list {A kind : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.t)
  (chain_id :
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (raw_operation : Tezos_raw_protocol_alpha.Alpha_context.Operation.t A)
  (contents_list :
    Tezos_raw_protocol_alpha.Alpha_context.contents_list
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.context) :=
  match contents_list with
  |
    Tezos_raw_protocol_alpha.Alpha_context.Single
      ((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _) as op) =>
    precheck_manager_contents ctxt chain_id raw_operation op
  |
    Tezos_raw_protocol_alpha.Alpha_context.Cons
      ((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _) as op) rest
    =>
    op_gtgteqquestion (precheck_manager_contents ctxt chain_id raw_operation op)
      (fun ctxt =>
        precheck_manager_contents_list ctxt chain_id raw_operation rest)
  end.

Fixpoint apply_manager_contents_list_rec {kind : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.t)
  (mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
  (baker : Tezos_raw_protocol_alpha.Alpha_context.public_key_hash)
  (chain_id :
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (contents_list :
    Tezos_raw_protocol_alpha.Alpha_context.contents_list
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (variant *
      Tezos_raw_protocol_alpha.Apply_results.contents_result_list
        (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind)) :=
  let level := Level.current ctxt in
  match contents_list with
  |
    Tezos_raw_protocol_alpha.Alpha_context.Single
      ((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
        source := source; fee := fee |}) as op) =>
    let source := Contract.implicit_contract source in
    op_gtgteq (apply_manager_contents ctxt mode chain_id op)
      (fun function_parameter =>
        let '(ctxt_result, operation_result, internal_operation_results) :=
          function_parameter in
        let result :=
          Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result
            {|
              balance_updates :=
                Delegate.cleanup_balance_updates
                  (cons
                    ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                      source),
                      (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                        fee))
                    (cons
                      ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Fees
                        baker (cycle level)),
                        (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                          fee)) [])); operation_result := operation_result;
              internal_operation_results := internal_operation_results |} in
        Lwt.__return
          (ctxt_result,
            (Tezos_raw_protocol_alpha.Apply_results.Single_result result)))
  |
    Tezos_raw_protocol_alpha.Alpha_context.Cons
      ((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
        source := source; fee := fee |}) as op) rest =>
    let source := Contract.implicit_contract source in
    op_gtgteq (apply_manager_contents ctxt mode chain_id op)
      (fun function_parameter =>
        match function_parameter with
        | (Failure, operation_result, internal_operation_results) =>
          let result :=
            Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result
              {|
                balance_updates :=
                  Delegate.cleanup_balance_updates
                    (cons
                      ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                        source),
                        (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                          fee))
                      (cons
                        ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Fees
                          baker (cycle level)),
                          (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                            fee)) [])); operation_result := operation_result;
                internal_operation_results := internal_operation_results |} in
          Lwt.__return
            ((* ❌ Variants not supported *)
            variant,
              (Tezos_raw_protocol_alpha.Apply_results.Cons_result result
                (mark_skipped baker level rest)))
        | (Success ctxt, operation_result, internal_operation_results) =>
          let result :=
            Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result
              {|
                balance_updates :=
                  Delegate.cleanup_balance_updates
                    (cons
                      ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                        source),
                        (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                          fee))
                      (cons
                        ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Fees
                          baker (cycle level)),
                          (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                            fee)) [])); operation_result := operation_result;
                internal_operation_results := internal_operation_results |} in
          op_gtgteq
            (apply_manager_contents_list_rec ctxt mode baker chain_id rest)
            (fun function_parameter =>
              let '(ctxt_result, results) := function_parameter in
              Lwt.__return
                (ctxt_result,
                  (Tezos_raw_protocol_alpha.Apply_results.Cons_result result
                    results)))
        end)
  end.

Definition mark_backtracked {A : Type}
  (results :
    Tezos_raw_protocol_alpha.Apply_results.contents_result_list
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A))
  : Tezos_raw_protocol_alpha.Apply_results.contents_result_list
    (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A) :=
  let fix mark_contents_list {kind : Type}
    (function_parameter :
    Tezos_raw_protocol_alpha.Apply_results.contents_result_list
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind))
    : Tezos_raw_protocol_alpha.Apply_results.contents_result_list
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) :=
    match function_parameter with
    |
      Tezos_raw_protocol_alpha.Apply_results.Single_result
        (Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result op) =>
      Tezos_raw_protocol_alpha.Apply_results.Single_result
        (Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result
          {| balance_updates := balance_updates op;
            operation_result :=
              mark_manager_operation_result (operation_result op);
            internal_operation_results :=
              List.map mark_internal_operation_results
                (internal_operation_results op) |})
    |
      Tezos_raw_protocol_alpha.Apply_results.Cons_result
        (Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result op)
        rest =>
      Tezos_raw_protocol_alpha.Apply_results.Cons_result
        (Tezos_raw_protocol_alpha.Apply_results.Manager_operation_result
          {| balance_updates := balance_updates op;
            operation_result :=
              mark_manager_operation_result (operation_result op);
            internal_operation_results :=
              List.map mark_internal_operation_results
                (internal_operation_results op) |}) (mark_contents_list rest)
    end
  with mark_internal_operation_results
    (function_parameter :
    Tezos_raw_protocol_alpha.Apply_results.packed_internal_operation_result)
    : Tezos_raw_protocol_alpha.Apply_results.packed_internal_operation_result :=
    let
      'Tezos_raw_protocol_alpha.Apply_results.Internal_operation_result kind
        result := function_parameter in
    Tezos_raw_protocol_alpha.Apply_results.Internal_operation_result kind
      (mark_manager_operation_result result)
  with mark_manager_operation_result {kind : Type}
    (function_parameter :
    Tezos_raw_protocol_alpha.Apply_results.manager_operation_result kind)
    : Tezos_raw_protocol_alpha.Apply_results.manager_operation_result kind :=
    match function_parameter with
    |
      (Tezos_raw_protocol_alpha.Apply_results.Failed _ _ |
        Tezos_raw_protocol_alpha.Apply_results.Skipped _ |
        Tezos_raw_protocol_alpha.Apply_results.Backtracked _ _) as result =>
      result
    |
      (Tezos_raw_protocol_alpha.Apply_results.Applied
        (Tezos_raw_protocol_alpha.Apply_results.Reveal_result _)) as result =>
      result
    | Tezos_raw_protocol_alpha.Apply_results.Applied result =>
      Tezos_raw_protocol_alpha.Apply_results.Backtracked result None
    end in
  mark_contents_list results.

Definition apply_manager_contents_list {A : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.t)
  (mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
  (baker : Tezos_raw_protocol_alpha.Alpha_context.public_key_hash)
  (chain_id :
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (contents_list :
    Tezos_raw_protocol_alpha.Alpha_context.contents_list
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_raw_protocol_alpha.Alpha_context.t *
      Tezos_raw_protocol_alpha.Apply_results.contents_result_list
        (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A)) :=
  op_gtgteq
    (apply_manager_contents_list_rec ctxt mode baker chain_id contents_list)
    (fun function_parameter =>
      let '(ctxt_result, results) := function_parameter in
      match ctxt_result with
      | Failure => Lwt.__return (ctxt, (mark_backtracked results))
      | Success ctxt =>
        op_gtgteq (Big_map.cleanup_temporary ctxt)
          (fun ctxt => Lwt.__return (ctxt, results))
      end).

Definition apply_contents_list {A : Type}
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (chain_id :
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
  (pred_block :
    Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (baker :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (operation : Tezos_raw_protocol_alpha.Alpha_context.operation A)
  (contents_list : Tezos_raw_protocol_alpha.Alpha_context.contents_list A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.context *
        Tezos_raw_protocol_alpha.Apply_results.contents_result_list A)) :=
  match contents_list with
  |
    Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Endorsement {| level := level |})
    =>
    let block := branch (shell operation) in
    op_gtgteqquestion
      (fail_unless
        (Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.equal)
          block pred_block)
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_endorsement_predecessor
          pred_block block))
      (fun function_parameter =>
        let 'tt := function_parameter in
        let current_level := level (Level.current ctxt) in
        op_gtgteqquestion
          (fail_unless (op_eq (succ level) current_level)
            Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_endorsement_level)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (Baking.check_endorsement_rights ctxt chain_id operation)
              (fun function_parameter =>
                let '(delegate, slots, used) := function_parameter in
                if used then
                  fail
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_endorsement
                      delegate)
                else
                  let ctxt := record_endorsement ctxt delegate in
                  let gap := List.length slots in
                  op_gtgteqquestion
                    (Lwt.__return
                      (op_starquestion
                        (Constants.endorsement_security_deposit ctxt)
                        (Int64.of_int gap)))
                    (fun deposit =>
                      op_gtgteqquestion
                        (Delegate.freeze_deposit ctxt delegate deposit)
                        (fun ctxt =>
                          op_gtgteqquestion (Global.get_block_priority ctxt)
                            (fun block_priority =>
                              op_gtgteqquestion
                                (Baking.endorsing_reward ctxt block_priority gap)
                                (fun reward =>
                                  op_gtgteqquestion
                                    (Delegate.freeze_rewards ctxt delegate
                                      reward)
                                    (fun ctxt =>
                                      let level :=
                                        Level.from_raw ctxt None level in
                                      __return
                                        (ctxt,
                                          (Tezos_raw_protocol_alpha.Apply_results.Single_result
                                            (Tezos_raw_protocol_alpha.Apply_results.Endorsement_result
                                              {|
                                                balance_updates :=
                                                  Delegate.cleanup_balance_updates
                                                    (cons
                                                      ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                        (Contract.implicit_contract
                                                          delegate)),
                                                        (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                          deposit))
                                                      (cons
                                                        ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Deposits
                                                          delegate (cycle level)),
                                                          (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                                                            deposit))
                                                        (cons
                                                          ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Rewards
                                                            delegate
                                                            (cycle level)),
                                                            (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                                                              reward)) [])));
                                                delegate := delegate;
                                                slots := slots |})))))))))))
  |
    Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation {|
        level := level; nonce := nonce |}) =>
    let level := Level.from_raw ctxt None level in
    op_gtgteqquestion (Nonce.reveal ctxt level nonce)
      (fun ctxt =>
        let seed_nonce_revelation_tip :=
          Constants.seed_nonce_revelation_tip ctxt in
        op_gtgteqquestion (add_rewards ctxt seed_nonce_revelation_tip)
          (fun ctxt =>
            __return
              (ctxt,
                (Tezos_raw_protocol_alpha.Apply_results.Single_result
                  (Tezos_raw_protocol_alpha.Apply_results.Seed_nonce_revelation_result
                    (cons
                      ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Rewards
                        baker (cycle level)),
                        (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                          seed_nonce_revelation_tip)) []))))))
  |
    Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence {|
        op1 := op1; op2 := op2 |}) =>
    match ((contents (protocol_data op1)), (contents (protocol_data op2))) with
    |
      (Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Endorsement e1),
        Tezos_raw_protocol_alpha.Alpha_context.Single
          (Tezos_raw_protocol_alpha.Alpha_context.Endorsement e2)) =>
      let level := Level.from_raw ctxt None (level e1) in
      let oldest_level := Level.last_allowed_fork_level ctxt in
      op_gtgteqquestion
        (fail_unless (op_lt level (Level.current ctxt))
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_double_endorsement_evidence
            {| level := level level; current := level (Level.current ctxt) |}))
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgteqquestion
            (fail_unless (op_lteq oldest_level (level level))
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Outdated_double_endorsement_evidence
                {| level := level level; last := oldest_level |}))
            (fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteqquestion
                (Baking.check_endorsement_rights ctxt chain_id op1)
                (fun function_parameter =>
                  let '(delegate1, _, _) := function_parameter in
                  op_gtgteqquestion
                    (Baking.check_endorsement_rights ctxt chain_id op2)
                    (fun function_parameter =>
                      let '(delegate2, _, _) := function_parameter in
                      op_gtgteqquestion
                        (fail_unless
                          (Signature.Public_key_hash.equal delegate1 delegate2)
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_double_endorsement_evidence
                            {| delegate1 := delegate1; delegate2 := delegate2 |}))
                        (fun function_parameter =>
                          let 'tt := function_parameter in
                          op_gtgteqquestion
                            (Delegate.has_frozen_balance ctxt delegate1
                              (cycle level))
                            (fun valid =>
                              op_gtgteqquestion
                                (fail_unless valid
                                  Tezos_protocol_environment_alpha__Environment.Error_monad.Unrequired_double_endorsement_evidence)
                                (fun function_parameter =>
                                  let 'tt := function_parameter in
                                  op_gtgteqquestion
                                    (Delegate.punish ctxt delegate1
                                      (cycle level))
                                    (fun function_parameter =>
                                      let '(ctxt, balance) := function_parameter
                                        in
                                      op_gtgteqquestion
                                        (Lwt.__return
                                          (op_plusquestion (deposit balance)
                                            (fees balance)))
                                        (fun burned =>
                                          let reward :=
                                            match
                                              op_divquestion burned
                                                (* ❌ Constant of type int64 is converted to int *)
                                                2 with
                                            |
                                              Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                                                v => v
                                            |
                                              Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                                                _ => Tez.zero
                                            end in
                                          op_gtgteqquestion
                                            (add_rewards ctxt reward)
                                            (fun ctxt =>
                                              let current_cycle :=
                                                cycle (Level.current ctxt) in
                                              __return
                                                (ctxt,
                                                  (Tezos_raw_protocol_alpha.Apply_results.Single_result
                                                    (Tezos_raw_protocol_alpha.Apply_results.Double_endorsement_evidence_result
                                                      (Delegate.cleanup_balance_updates
                                                        (cons
                                                          ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Deposits
                                                            delegate1
                                                            (cycle level)),
                                                            (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                              (deposit balance)))
                                                          (cons
                                                            ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Fees
                                                              delegate1
                                                              (cycle level)),
                                                              (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                                (fees balance)))
                                                            (cons
                                                              ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Rewards
                                                                delegate1
                                                                (cycle level)),
                                                                (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                                  (rewards
                                                                    balance)))
                                                              (cons
                                                                ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Rewards
                                                                  baker
                                                                  current_cycle),
                                                                  (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                                                                    reward)) []))))))))))))))))))
    | (_, _) =>
      fail
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_double_endorsement_evidence
    end
  |
    Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence {|
        bh1 := bh1; bh2 := bh2 |}) =>
    let hash1 := Block_header.hash bh1 in
    let hash2 := Block_header.hash bh2 in
    op_gtgteqquestion
      (fail_unless
        (op_andand
          (Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
            (level (shell bh1)) (level (shell bh2)))
          (not
            (Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.equal)
              hash1 hash2)))
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_double_baking_evidence
          {| hash1 := hash1; level1 := level (shell bh1); hash2 := hash2;
            level2 := level (shell bh2) |}))
      (fun function_parameter =>
        let 'tt := function_parameter in
        op_gtgteqquestion
          (Lwt.__return (Raw_level.of_int32 (level (shell bh1))))
          (fun raw_level =>
            let oldest_level := Level.last_allowed_fork_level ctxt in
            op_gtgteqquestion
              (fail_unless (op_lt raw_level (level (Level.current ctxt)))
                (Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_double_baking_evidence
                  {| level := raw_level; current := level (Level.current ctxt)
                    |}))
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion
                  (fail_unless (op_lteq oldest_level raw_level)
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.Outdated_double_baking_evidence
                      {| level := raw_level; last := oldest_level |}))
                  (fun function_parameter =>
                    let 'tt := function_parameter in
                    let level := Level.from_raw ctxt None raw_level in
                    op_gtgteqquestion
                      (Roll.baking_rights_owner ctxt level
                        (priority (contents (protocol_data bh1))))
                      (fun delegate1 =>
                        op_gtgteqquestion
                          (Baking.check_signature bh1 chain_id delegate1)
                          (fun function_parameter =>
                            let 'tt := function_parameter in
                            op_gtgteqquestion
                              (Roll.baking_rights_owner ctxt level
                                (priority (contents (protocol_data bh2))))
                              (fun delegate2 =>
                                op_gtgteqquestion
                                  (Baking.check_signature bh2 chain_id delegate2)
                                  (fun function_parameter =>
                                    let 'tt := function_parameter in
                                    op_gtgteqquestion
                                      (fail_unless
                                        (Signature.Public_key.equal delegate1
                                          delegate2)
                                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_double_baking_evidence
                                          {|
                                            delegate1 :=
                                              Signature.Public_key.hash
                                                delegate1;
                                            delegate2 :=
                                              Signature.Public_key.hash
                                                delegate2 |}))
                                      (fun function_parameter =>
                                        let 'tt := function_parameter in
                                        let delegate :=
                                          Signature.Public_key.hash delegate1 in
                                        op_gtgteqquestion
                                          (Delegate.has_frozen_balance ctxt
                                            delegate (cycle level))
                                          (fun valid =>
                                            op_gtgteqquestion
                                              (fail_unless valid
                                                Tezos_protocol_environment_alpha__Environment.Error_monad.Unrequired_double_baking_evidence)
                                              (fun function_parameter =>
                                                let 'tt := function_parameter in
                                                op_gtgteqquestion
                                                  (Delegate.punish ctxt delegate
                                                    (cycle level))
                                                  (fun function_parameter =>
                                                    let '(ctxt, balance) :=
                                                      function_parameter in
                                                    op_gtgteqquestion
                                                      (Lwt.__return
                                                        (op_plusquestion
                                                          (deposit balance)
                                                          (fees balance)))
                                                      (fun burned =>
                                                        let reward :=
                                                          match
                                                            op_divquestion
                                                              burned
                                                              (* ❌ Constant of type int64 is converted to int *)
                                                              2 with
                                                          |
                                                            Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                                                              v => v
                                                          |
                                                            Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                                                              _ => Tez.zero
                                                          end in
                                                        op_gtgteqquestion
                                                          (add_rewards ctxt
                                                            reward)
                                                          (fun ctxt =>
                                                            let current_cycle :=
                                                              cycle
                                                                (Level.current
                                                                  ctxt) in
                                                            __return
                                                              (ctxt,
                                                                (Tezos_raw_protocol_alpha.Apply_results.Single_result
                                                                  (Tezos_raw_protocol_alpha.Apply_results.Double_baking_evidence_result
                                                                    (Delegate.cleanup_balance_updates
                                                                      (cons
                                                                        ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Deposits
                                                                          delegate
                                                                          (cycle
                                                                            level)),
                                                                          (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                                            (deposit
                                                                              balance)))
                                                                        (cons
                                                                          ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Fees
                                                                            delegate
                                                                            (cycle
                                                                              level)),
                                                                            (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                                              (fees
                                                                                balance)))
                                                                          (cons
                                                                            ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Rewards
                                                                              delegate
                                                                              (cycle
                                                                                level)),
                                                                              (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                                                (rewards
                                                                                  balance)))
                                                                            (cons
                                                                              ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Rewards
                                                                                baker
                                                                                current_cycle),
                                                                                (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                                                                                  reward))
                                                                              []))))))))))))))))))))))
  |
    Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Activate_account {|
        id := pkh; activation_code := activation_code |}) =>
    let blinded_pkh :=
      Blinded_public_key_hash.of_ed25519_pkh activation_code pkh in
    op_gtgteqquestion (Commitment.get_opt ctxt blinded_pkh)
      (fun function_parameter =>
        match function_parameter with
        | None =>
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_activation
              {| pkh := pkh |})
        | Some amount =>
          op_gtgteqquestion (Commitment.delete ctxt blinded_pkh)
            (fun ctxt =>
              let contract :=
                Contract.implicit_contract
                  (Tezos_protocol_environment_alpha__Environment.Signature.Ed25519
                    pkh) in
              op_gtgteqquestion (credit ctxt contract amount)
                (fun ctxt =>
                  __return
                    (ctxt,
                      (Tezos_raw_protocol_alpha.Apply_results.Single_result
                        (Tezos_raw_protocol_alpha.Apply_results.Activate_account_result
                          (cons
                            ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                              contract),
                              (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                                amount)) []))))))
        end)
  |
    Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Proposals {|
        source := source; period := period; proposals := proposals |}) =>
    op_gtgteqquestion (Roll.delegate_pubkey ctxt source)
      (fun delegate =>
        op_gtgteqquestion
          (Operation.check_signature delegate chain_id operation)
          (fun function_parameter =>
            let 'tt := function_parameter in
            let level := Level.current ctxt in
            op_gtgteqquestion
              (fail_unless (op_eq (voting_period level) period)
                (Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_voting_period
                  (voting_period level) period))
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion
                  (Amendment.record_proposals ctxt source proposals)
                  (fun ctxt =>
                    __return
                      (ctxt,
                        (Tezos_raw_protocol_alpha.Apply_results.Single_result
                          Tezos_raw_protocol_alpha.Apply_results.Proposals_result))))))
  |
    Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Ballot {|
        source := source;
          period := period;
          proposal := proposal;
          ballot := ballot
          |}) =>
    op_gtgteqquestion (Roll.delegate_pubkey ctxt source)
      (fun delegate =>
        op_gtgteqquestion
          (Operation.check_signature delegate chain_id operation)
          (fun function_parameter =>
            let 'tt := function_parameter in
            let level := Level.current ctxt in
            op_gtgteqquestion
              (fail_unless (op_eq (voting_period level) period)
                (Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_voting_period
                  (voting_period level) period))
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion
                  (Amendment.record_ballot ctxt source proposal ballot)
                  (fun ctxt =>
                    __return
                      (ctxt,
                        (Tezos_raw_protocol_alpha.Apply_results.Single_result
                          Tezos_raw_protocol_alpha.Apply_results.Ballot_result))))))
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _)) as op =>
    op_gtgteqquestion
      (precheck_manager_contents_list ctxt chain_id operation op)
      (fun ctxt =>
        op_gtgteq (apply_manager_contents_list ctxt mode baker chain_id op)
          (fun function_parameter =>
            let '(ctxt, result) := function_parameter in
            __return (ctxt, result)))
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Cons
      (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _) _) as op =>
    op_gtgteqquestion
      (precheck_manager_contents_list ctxt chain_id operation op)
      (fun ctxt =>
        op_gtgteq (apply_manager_contents_list ctxt mode baker chain_id op)
          (fun function_parameter =>
            let '(ctxt, result) := function_parameter in
            __return (ctxt, result)))
  end.

Definition apply_operation {A : Type}
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (chain_id :
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
  (pred_block :
    Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (baker :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (hash :
    Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (operation : Tezos_raw_protocol_alpha.Alpha_context.operation A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha__Alpha_context.context *
        Tezos_raw_protocol_alpha.Apply_results.operation_metadata A)) :=
  let ctxt := Contract.init_origination_nonce ctxt hash in
  op_gtgteqquestion
    (apply_contents_list ctxt chain_id mode pred_block baker operation
      (contents (protocol_data operation)))
    (fun function_parameter =>
      let '(ctxt, result) := function_parameter in
      let ctxt := Gas.set_unlimited ctxt in
      let ctxt := Contract.unset_origination_nonce ctxt in
      __return (ctxt, {| contents := result |})).

Definition may_snapshot_roll
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha__Alpha_context.context) :=
  let level := Alpha_context.Level.current ctxt in
  let blocks_per_roll_snapshot := Constants.blocks_per_roll_snapshot ctxt in
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.equal)
      (Int32.rem (cycle_position level) blocks_per_roll_snapshot)
      (Int32.pred blocks_per_roll_snapshot) then
    op_gtgteqquestion (Alpha_context.Roll.snapshot_rolls ctxt)
      (fun ctxt => __return ctxt)
  else
    __return ctxt.

Definition may_start_new_cycle
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.context *
        Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates *
        list
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)) :=
  op_gtgteqquestion (Baking.dawn_of_a_new_cycle ctxt)
    (fun function_parameter =>
      match function_parameter with
      | None => __return (ctxt, [], [])
      | Some last_cycle =>
        op_gtgteqquestion (Seed.cycle_end ctxt last_cycle)
          (fun function_parameter =>
            let '(ctxt, unrevealed) := function_parameter in
            op_gtgteqquestion (Roll.cycle_end ctxt last_cycle)
              (fun ctxt =>
                op_gtgteqquestion
                  (Delegate.cycle_end ctxt last_cycle unrevealed)
                  (fun function_parameter =>
                    let '(ctxt, update_balances, deactivated) :=
                      function_parameter in
                    op_gtgteqquestion (Bootstrap.cycle_end ctxt last_cycle)
                      (fun ctxt => __return (ctxt, update_balances, deactivated)))))
      end).

Definition begin_full_construction
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (pred_timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (protocol_data : Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.context *
        Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents *
        Tezos_raw_protocol_alpha.Alpha_context.public_key *
        Tezos_raw_protocol_alpha.Alpha_context.Period.t)) :=
  op_gtgteqquestion
    (Alpha_context.Global.set_block_priority ctxt
      (Block_header.priority protocol_data))
    (fun ctxt =>
      op_gtgteqquestion
        (Baking.check_baking_rights ctxt protocol_data pred_timestamp)
        (fun function_parameter =>
          let '(delegate_pk, block_delay) := function_parameter in
          let ctxt := Fitness.increase None ctxt in
          match Level.pred ctxt (Level.current ctxt) with
          | None =>
            (* ❌ Assert instruction is not handled. *)
            assert false
          | Some pred_level =>
            op_gtgteqquestion (Baking.endorsement_rights ctxt pred_level)
              (fun rights =>
                let ctxt := init_endorsements ctxt rights in
                __return (ctxt, protocol_data, delegate_pk, block_delay))
          end)).

Definition begin_partial_construction
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.context) :=
  let ctxt := Fitness.increase None ctxt in
  match Level.pred ctxt (Level.current ctxt) with
  | None =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | Some pred_level =>
    op_gtgteqquestion (Baking.endorsement_rights ctxt pred_level)
      (fun rights =>
        let ctxt := init_endorsements ctxt rights in
        __return ctxt)
  end.

Definition begin_application
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (chain_id :
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (block_header : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
  (pred_timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.context *
        Tezos_raw_protocol_alpha.Alpha_context.public_key *
        Tezos_raw_protocol_alpha.Alpha_context.Period.t)) :=
  op_gtgteqquestion
    (Alpha_context.Global.set_block_priority ctxt
      (priority (contents (Block_header.protocol_data block_header))))
    (fun ctxt =>
      let current_level := Alpha_context.Level.current ctxt in
      op_gtgteqquestion (Baking.check_proof_of_work_stamp ctxt block_header)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgteqquestion (Baking.check_fitness_gap ctxt block_header)
            (fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteqquestion
                (Baking.check_baking_rights ctxt
                  (contents (protocol_data block_header)) pred_timestamp)
                (fun function_parameter =>
                  let '(delegate_pk, block_delay) := function_parameter in
                  op_gtgteqquestion
                    (Baking.check_signature block_header chain_id delegate_pk)
                    (fun function_parameter =>
                      let 'tt := function_parameter in
                      let has_commitment :=
                        match
                          seed_nonce_hash
                            (contents (protocol_data block_header)) with
                        | None => false
                        | Some _ => true
                        end in
                      op_gtgteqquestion
                        (fail_unless
                          (Tezos_protocol_environment_alpha__Environment.Compare.Bool.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
                            has_commitment (expected_commitment current_level))
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_commitment
                            {| expected := expected_commitment current_level |}))
                        (fun function_parameter =>
                          let 'tt := function_parameter in
                          let ctxt := Fitness.increase None ctxt in
                          match Level.pred ctxt (Level.current ctxt) with
                          | None =>
                            (* ❌ Assert instruction is not handled. *)
                            assert false
                          | Some pred_level =>
                            op_gtgteqquestion
                              (Baking.endorsement_rights ctxt pred_level)
                              (fun rights =>
                                let ctxt := init_endorsements ctxt rights in
                                __return (ctxt, delegate_pk, block_delay))
                          end)))))).

Definition check_minimum_endorsements
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (protocol_data : Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents)
  (block_delay : Tezos_raw_protocol_alpha.Alpha_context.Period.t)
  (included_endorsements :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let minimum := Baking.minimum_allowed_endorsements ctxt block_delay in
  let timestamp := Timestamp.current ctxt in
  fail_unless
    (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
      included_endorsements minimum)
    (Tezos_protocol_environment_alpha__Environment.Error_monad.Not_enough_endorsements_for_priority
      {| required := minimum; priority := Block_header.priority protocol_data;
        endorsements := included_endorsements; timestamp := timestamp |}).

Definition finalize_application
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (protocol_data : Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (block_delay : Tezos_raw_protocol_alpha.Alpha_context.Period.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.context *
        Tezos_raw_protocol_alpha.Apply_results.block_metadata)) :=
  let included_endorsements := included_endorsements ctxt in
  op_gtgteqquestion
    (check_minimum_endorsements ctxt protocol_data block_delay
      included_endorsements)
    (fun function_parameter =>
      let 'tt := function_parameter in
      let deposit := Constants.block_security_deposit ctxt in
      op_gtgteqquestion (add_deposit ctxt delegate deposit)
        (fun ctxt =>
          op_gtgteqquestion
            (Baking.baking_reward ctxt (priority protocol_data)
              included_endorsements)
            (fun reward =>
              op_gtgteqquestion (add_rewards ctxt reward)
                (fun ctxt =>
                  op_gtgteqquestion
                    (Signature.Public_key_hash.Map.fold
                      (fun delegate =>
                        fun deposit =>
                          fun ctxt =>
                            op_gtgteqquestion ctxt
                              (fun ctxt =>
                                Delegate.freeze_deposit ctxt delegate deposit))
                      (get_deposits ctxt) (__return ctxt))
                    (fun ctxt =>
                      let fees := Alpha_context.get_fees ctxt in
                      op_gtgteqquestion
                        (Delegate.freeze_fees ctxt delegate fees)
                        (fun ctxt =>
                          let rewards := Alpha_context.get_rewards ctxt in
                          op_gtgteqquestion
                            (Delegate.freeze_rewards ctxt delegate rewards)
                            (fun ctxt =>
                              op_gtgteqquestion
                                match Block_header.seed_nonce_hash protocol_data
                                  with
                                | None => __return ctxt
                                | Some nonce_hash =>
                                  Nonce.record_hash ctxt
                                    {| nonce_hash := nonce_hash;
                                      delegate := delegate; rewards := rewards;
                                      fees := fees |}
                                end
                                (fun ctxt =>
                                  op_gtgteqquestion (may_snapshot_roll ctxt)
                                    (fun ctxt =>
                                      op_gtgteqquestion
                                        (may_start_new_cycle ctxt)
                                        (fun function_parameter =>
                                          let
                                            '(ctxt, balance_updates, deactivated) :=
                                            function_parameter in
                                          op_gtgteqquestion
                                            (Amendment.may_start_new_voting_period
                                              ctxt)
                                            (fun ctxt =>
                                              let cycle :=
                                                cycle (Level.current ctxt) in
                                              let balance_updates :=
                                                cleanup_balance_updates
                                                  (op_at
                                                    (cons
                                                      ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Contract
                                                        (Contract.implicit_contract
                                                          delegate)),
                                                        (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Debited
                                                          deposit))
                                                      (cons
                                                        ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Deposits
                                                          delegate cycle),
                                                          (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                                                            deposit))
                                                        (cons
                                                          ((Tezos_raw_protocol_alpha.Alpha_context.Delegate.Rewards
                                                            delegate cycle),
                                                            (Tezos_raw_protocol_alpha.Alpha_context.Delegate.Credited
                                                              reward)) [])))
                                                    balance_updates) in
                                              let consumed_gas :=
                                                Z.sub
                                                  (Constants.hard_gas_limit_per_block
                                                    ctxt)
                                                  (Alpha_context.Gas.block_level
                                                    ctxt) in
                                              op_gtgteqquestion
                                                (Alpha_context.Vote.get_current_period_kind
                                                  ctxt)
                                                (fun voting_period_kind =>
                                                  let receipt :=
                                                    {| baker := delegate;
                                                      level :=
                                                        Level.current ctxt;
                                                      voting_period_kind :=
                                                        voting_period_kind;
                                                      nonce_hash :=
                                                        seed_nonce_hash
                                                          protocol_data;
                                                      consumed_gas :=
                                                        consumed_gas;
                                                      deactivated := deactivated;
                                                      balance_updates :=
                                                        balance_updates |} in
                                                  __return (ctxt, receipt))))))))))))).
apply_results.ml 22 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Data_encoding

let error_encoding =
  def
    "error"
    ~description:
      "The full list of RPC errors would be too long to include.\n\
       It is available at RPC `/errors` (GET).\n\
       Errors specific to protocol Alpha have an id that starts with \
       `proto.alpha`."
  @@ splitted
       ~json:
         (conv
            (fun err ->
              Data_encoding.Json.construct Error_monad.error_encoding err)
            (fun json ->
              Data_encoding.Json.destruct Error_monad.error_encoding json)
            json)
       ~binary:Error_monad.error_encoding

type _ successful_manager_operation_result =
  | Reveal_result : {
      consumed_gas : Z.t;
    }
      -> Kind.reveal successful_manager_operation_result
  | Transaction_result : {
      storage : Script.expr option;
      big_map_diff : Contract.big_map_diff option;
      balance_updates : Delegate.balance_updates;
      originated_contracts : Contract.t list;
      consumed_gas : Z.t;
      storage_size : Z.t;
      paid_storage_size_diff : Z.t;
      allocated_destination_contract : bool;
    }
      -> Kind.transaction successful_manager_operation_result
  | Origination_result : {
      big_map_diff : Contract.big_map_diff option;
      balance_updates : Delegate.balance_updates;
      originated_contracts : Contract.t list;
      consumed_gas : Z.t;
      storage_size : Z.t;
      paid_storage_size_diff : Z.t;
    }
      -> Kind.origination successful_manager_operation_result
  | Delegation_result : {
      consumed_gas : Z.t;
    }
      -> Kind.delegation successful_manager_operation_result

type packed_successful_manager_operation_result =
  | Successful_manager_result :
      'kind successful_manager_operation_result
      -> packed_successful_manager_operation_result

type 'kind manager_operation_result =
  | Applied of 'kind successful_manager_operation_result
  | Backtracked of
      'kind successful_manager_operation_result * error list option
  | Failed : 'kind Kind.manager * error list -> 'kind manager_operation_result
  | Skipped : 'kind Kind.manager -> 'kind manager_operation_result

type packed_internal_operation_result =
  | Internal_operation_result :
      'kind internal_operation * 'kind manager_operation_result
      -> packed_internal_operation_result

module Manager_result = struct
  type 'kind case =
    | MCase : {
        op_case : 'kind Operation.Encoding.Manager_operations.case;
        encoding : 'a Data_encoding.t;
        kind : 'kind Kind.manager;
        iselect :
          packed_internal_operation_result ->
          ('kind internal_operation * 'kind manager_operation_result) option;
        select :
          packed_successful_manager_operation_result ->
          'kind successful_manager_operation_result option;
        proj : 'kind successful_manager_operation_result -> 'a;
        inj : 'a -> 'kind successful_manager_operation_result;
        t : 'kind manager_operation_result Data_encoding.t;
      }
        -> 'kind case

  let make ~op_case ~encoding ~kind ~iselect ~select ~proj ~inj =
    let (Operation.Encoding.Manager_operations.MCase {name; _}) = op_case in
    let t =
      def (Format.asprintf "operation.alpha.operation_result.%s" name)
      @@ union
           ~tag_size:`Uint8
           [ case
               (Tag 0)
               ~title:"Applied"
               (merge_objs (obj1 (req "status" (constant "applied"))) encoding)
               (fun o ->
                 match o with
                 | Skipped _ | Failed _ | Backtracked _ ->
                     None
                 | Applied o -> (
                   match select (Successful_manager_result o) with
                   | None ->
                       None
                   | Some o ->
                       Some ((), proj o) ))
               (fun ((), x) -> Applied (inj x));
             case
               (Tag 1)
               ~title:"Failed"
               (obj2
                  (req "status" (constant "failed"))
                  (req "errors" (list error_encoding)))
               (function Failed (_, errs) -> Some ((), errs) | _ -> None)
               (fun ((), errs) -> Failed (kind, errs));
             case
               (Tag 2)
               ~title:"Skipped"
               (obj1 (req "status" (constant "skipped")))
               (function Skipped _ -> Some () | _ -> None)
               (fun () -> Skipped kind);
             case
               (Tag 3)
               ~title:"Backtracked"
               (merge_objs
                  (obj2
                     (req "status" (constant "backtracked"))
                     (opt "errors" (list error_encoding)))
                  encoding)
               (fun o ->
                 match o with
                 | Skipped _ | Failed _ | Applied _ ->
                     None
                 | Backtracked (o, errs) -> (
                   match select (Successful_manager_result o) with
                   | None ->
                       None
                   | Some o ->
                       Some (((), errs), proj o) ))
               (fun (((), errs), x) -> Backtracked (inj x, errs)) ]
    in
    MCase {op_case; encoding; kind; iselect; select; proj; inj; t}

  let reveal_case =
    make
      ~op_case:Operation.Encoding.Manager_operations.reveal_case
      ~encoding:Data_encoding.(obj1 (dft "consumed_gas" z Z.zero))
      ~iselect:(function
        | Internal_operation_result (({operation = Reveal _; _} as op), res) ->
            Some (op, res)
        | _ ->
            None)
      ~select:(function
        | Successful_manager_result (Reveal_result _ as op) ->
            Some op
        | _ ->
            None)
      ~kind:Kind.Reveal_manager_kind
      ~proj:(function Reveal_result {consumed_gas} -> consumed_gas)
      ~inj:(fun consumed_gas -> Reveal_result {consumed_gas})

  let transaction_case =
    make
      ~op_case:Operation.Encoding.Manager_operations.transaction_case
      ~encoding:
        (obj8
           (opt "storage" Script.expr_encoding)
           (opt "big_map_diff" Contract.big_map_diff_encoding)
           (dft "balance_updates" Delegate.balance_updates_encoding [])
           (dft "originated_contracts" (list Contract.encoding) [])
           (dft "consumed_gas" z Z.zero)
           (dft "storage_size" z Z.zero)
           (dft "paid_storage_size_diff" z Z.zero)
           (dft "allocated_destination_contract" bool false))
      ~iselect:(function
        | Internal_operation_result
            (({operation = Transaction _; _} as op), res) ->
            Some (op, res)
        | _ ->
            None)
      ~select:(function
        | Successful_manager_result (Transaction_result _ as op) ->
            Some op
        | _ ->
            None)
      ~kind:Kind.Transaction_manager_kind
      ~proj:(function
        | Transaction_result
            { storage;
              big_map_diff;
              balance_updates;
              originated_contracts;
              consumed_gas;
              storage_size;
              paid_storage_size_diff;
              allocated_destination_contract } ->
            ( storage,
              big_map_diff,
              balance_updates,
              originated_contracts,
              consumed_gas,
              storage_size,
              paid_storage_size_diff,
              allocated_destination_contract ))
      ~inj:
        (fun ( storage,
               big_map_diff,
               balance_updates,
               originated_contracts,
               consumed_gas,
               storage_size,
               paid_storage_size_diff,
               allocated_destination_contract ) ->
        Transaction_result
          {
            storage;
            big_map_diff;
            balance_updates;
            originated_contracts;
            consumed_gas;
            storage_size;
            paid_storage_size_diff;
            allocated_destination_contract;
          })

  let origination_case =
    make
      ~op_case:Operation.Encoding.Manager_operations.origination_case
      ~encoding:
        (obj6
           (opt "big_map_diff" Contract.big_map_diff_encoding)
           (dft "balance_updates" Delegate.balance_updates_encoding [])
           (dft "originated_contracts" (list Contract.encoding) [])
           (dft "consumed_gas" z Z.zero)
           (dft "storage_size" z Z.zero)
           (dft "paid_storage_size_diff" z Z.zero))
      ~iselect:(function
        | Internal_operation_result
            (({operation = Origination _; _} as op), res) ->
            Some (op, res)
        | _ ->
            None)
      ~select:(function
        | Successful_manager_result (Origination_result _ as op) ->
            Some op
        | _ ->
            None)
      ~proj:(function
        | Origination_result
            { big_map_diff;
              balance_updates;
              originated_contracts;
              consumed_gas;
              storage_size;
              paid_storage_size_diff } ->
            ( big_map_diff,
              balance_updates,
              originated_contracts,
              consumed_gas,
              storage_size,
              paid_storage_size_diff ))
      ~kind:Kind.Origination_manager_kind
      ~inj:
        (fun ( big_map_diff,
               balance_updates,
               originated_contracts,
               consumed_gas,
               storage_size,
               paid_storage_size_diff ) ->
        Origination_result
          {
            big_map_diff;
            balance_updates;
            originated_contracts;
            consumed_gas;
            storage_size;
            paid_storage_size_diff;
          })

  let delegation_case =
    make
      ~op_case:Operation.Encoding.Manager_operations.delegation_case
      ~encoding:Data_encoding.(obj1 (dft "consumed_gas" z Z.zero))
      ~iselect:(function
        | Internal_operation_result (({operation = Delegation _; _} as op), res)
          ->
            Some (op, res)
        | _ ->
            None)
      ~select:(function
        | Successful_manager_result (Delegation_result _ as op) ->
            Some op
        | _ ->
            None)
      ~kind:Kind.Delegation_manager_kind
      ~proj:(function Delegation_result {consumed_gas} -> consumed_gas)
      ~inj:(fun consumed_gas -> Delegation_result {consumed_gas})
end

let internal_operation_result_encoding :
    packed_internal_operation_result Data_encoding.t =
  let make (type kind)
      (Manager_result.MCase res_case : kind Manager_result.case) =
    let (Operation.Encoding.Manager_operations.MCase op_case) =
      res_case.op_case
    in
    case
      (Tag op_case.tag)
      ~title:op_case.name
      (merge_objs
         (obj3
            (req "kind" (constant op_case.name))
            (req "source" Contract.encoding)
            (req "nonce" uint16))
         (merge_objs op_case.encoding (obj1 (req "result" res_case.t))))
      (fun op ->
        match res_case.iselect op with
        | Some (op, res) ->
            Some (((), op.source, op.nonce), (op_case.proj op.operation, res))
        | None ->
            None)
      (fun (((), source, nonce), (op, res)) ->
        let op = {source; operation = op_case.inj op; nonce} in
        Internal_operation_result (op, res))
  in
  def "operation.alpha.internal_operation_result"
  @@ union
       [ make Manager_result.reveal_case;
         make Manager_result.transaction_case;
         make Manager_result.origination_case;
         make Manager_result.delegation_case ]

type 'kind contents_result =
  | Endorsement_result : {
      balance_updates : Delegate.balance_updates;
      delegate : Signature.Public_key_hash.t;
      slots : int list;
    }
      -> Kind.endorsement contents_result
  | Seed_nonce_revelation_result :
      Delegate.balance_updates
      -> Kind.seed_nonce_revelation contents_result
  | Double_endorsement_evidence_result :
      Delegate.balance_updates
      -> Kind.double_endorsement_evidence contents_result
  | Double_baking_evidence_result :
      Delegate.balance_updates
      -> Kind.double_baking_evidence contents_result
  | Activate_account_result :
      Delegate.balance_updates
      -> Kind.activate_account contents_result
  | Proposals_result : Kind.proposals contents_result
  | Ballot_result : Kind.ballot contents_result
  | Manager_operation_result : {
      balance_updates : Delegate.balance_updates;
      operation_result : 'kind manager_operation_result;
      internal_operation_results : packed_internal_operation_result list;
    }
      -> 'kind Kind.manager contents_result

type packed_contents_result =
  | Contents_result : 'kind contents_result -> packed_contents_result

type packed_contents_and_result =
  | Contents_and_result :
      'kind Operation.contents * 'kind contents_result
      -> packed_contents_and_result

type ('a, 'b) eq = Eq : ('a, 'a) eq

let equal_manager_kind :
    type a b. a Kind.manager -> b Kind.manager -> (a, b) eq option =
 fun ka kb ->
  match (ka, kb) with
  | (Kind.Reveal_manager_kind, Kind.Reveal_manager_kind) ->
      Some Eq
  | (Kind.Reveal_manager_kind, _) ->
      None
  | (Kind.Transaction_manager_kind, Kind.Transaction_manager_kind) ->
      Some Eq
  | (Kind.Transaction_manager_kind, _) ->
      None
  | (Kind.Origination_manager_kind, Kind.Origination_manager_kind) ->
      Some Eq
  | (Kind.Origination_manager_kind, _) ->
      None
  | (Kind.Delegation_manager_kind, Kind.Delegation_manager_kind) ->
      Some Eq
  | (Kind.Delegation_manager_kind, _) ->
      None

module Encoding = struct
  type 'kind case =
    | Case : {
        op_case : 'kind Operation.Encoding.case;
        encoding : 'a Data_encoding.t;
        select : packed_contents_result -> 'kind contents_result option;
        mselect :
          packed_contents_and_result ->
          ('kind contents * 'kind contents_result) option;
        proj : 'kind contents_result -> 'a;
        inj : 'a -> 'kind contents_result;
      }
        -> 'kind case

  let tagged_case tag name args proj inj =
    let open Data_encoding in
    case
      tag
      ~title:(String.capitalize_ascii name)
      (merge_objs (obj1 (req "kind" (constant name))) args)
      (fun x -> match proj x with None -> None | Some x -> Some ((), x))
      (fun ((), x) -> inj x)

  let endorsement_case =
    Case
      {
        op_case = Operation.Encoding.endorsement_case;
        encoding =
          obj3
            (req "balance_updates" Delegate.balance_updates_encoding)
            (req "delegate" Signature.Public_key_hash.encoding)
            (req "slots" (list uint8));
        select =
          (function
          | Contents_result (Endorsement_result _ as op) -> Some op | _ -> None);
        mselect =
          (function
          | Contents_and_result ((Endorsement _ as op), res) ->
              Some (op, res)
          | _ ->
              None);
        proj =
          (function
          | Endorsement_result {balance_updates; delegate; slots} ->
              (balance_updates, delegate, slots));
        inj =
          (fun (balance_updates, delegate, slots) ->
            Endorsement_result {balance_updates; delegate; slots});
      }

  let seed_nonce_revelation_case =
    Case
      {
        op_case = Operation.Encoding.seed_nonce_revelation_case;
        encoding =
          obj1 (req "balance_updates" Delegate.balance_updates_encoding);
        select =
          (function
          | Contents_result (Seed_nonce_revelation_result _ as op) ->
              Some op
          | _ ->
              None);
        mselect =
          (function
          | Contents_and_result ((Seed_nonce_revelation _ as op), res) ->
              Some (op, res)
          | _ ->
              None);
        proj = (fun (Seed_nonce_revelation_result bus) -> bus);
        inj = (fun bus -> Seed_nonce_revelation_result bus);
      }

  let double_endorsement_evidence_case =
    Case
      {
        op_case = Operation.Encoding.double_endorsement_evidence_case;
        encoding =
          obj1 (req "balance_updates" Delegate.balance_updates_encoding);
        select =
          (function
          | Contents_result (Double_endorsement_evidence_result _ as op) ->
              Some op
          | _ ->
              None);
        mselect =
          (function
          | Contents_and_result ((Double_endorsement_evidence _ as op), res) ->
              Some (op, res)
          | _ ->
              None);
        proj = (fun (Double_endorsement_evidence_result bus) -> bus);
        inj = (fun bus -> Double_endorsement_evidence_result bus);
      }

  let double_baking_evidence_case =
    Case
      {
        op_case = Operation.Encoding.double_baking_evidence_case;
        encoding =
          obj1 (req "balance_updates" Delegate.balance_updates_encoding);
        select =
          (function
          | Contents_result (Double_baking_evidence_result _ as op) ->
              Some op
          | _ ->
              None);
        mselect =
          (function
          | Contents_and_result ((Double_baking_evidence _ as op), res) ->
              Some (op, res)
          | _ ->
              None);
        proj = (fun (Double_baking_evidence_result bus) -> bus);
        inj = (fun bus -> Double_baking_evidence_result bus);
      }

  let activate_account_case =
    Case
      {
        op_case = Operation.Encoding.activate_account_case;
        encoding =
          obj1 (req "balance_updates" Delegate.balance_updates_encoding);
        select =
          (function
          | Contents_result (Activate_account_result _ as op) ->
              Some op
          | _ ->
              None);
        mselect =
          (function
          | Contents_and_result ((Activate_account _ as op), res) ->
              Some (op, res)
          | _ ->
              None);
        proj = (fun (Activate_account_result bus) -> bus);
        inj = (fun bus -> Activate_account_result bus);
      }

  let proposals_case =
    Case
      {
        op_case = Operation.Encoding.proposals_case;
        encoding = Data_encoding.empty;
        select =
          (function
          | Contents_result (Proposals_result as op) -> Some op | _ -> None);
        mselect =
          (function
          | Contents_and_result ((Proposals _ as op), res) ->
              Some (op, res)
          | _ ->
              None);
        proj = (fun Proposals_result -> ());
        inj = (fun () -> Proposals_result);
      }

  let ballot_case =
    Case
      {
        op_case = Operation.Encoding.ballot_case;
        encoding = Data_encoding.empty;
        select =
          (function
          | Contents_result (Ballot_result as op) -> Some op | _ -> None);
        mselect =
          (function
          | Contents_and_result ((Ballot _ as op), res) ->
              Some (op, res)
          | _ ->
              None);
        proj = (fun Ballot_result -> ());
        inj = (fun () -> Ballot_result);
      }

  let make_manager_case (type kind)
      (Operation.Encoding.Case op_case :
        kind Kind.manager Operation.Encoding.case)
      (Manager_result.MCase res_case : kind Manager_result.case) mselect =
    Case
      {
        op_case = Operation.Encoding.Case op_case;
        encoding =
          obj3
            (req "balance_updates" Delegate.balance_updates_encoding)
            (req "operation_result" res_case.t)
            (dft
               "internal_operation_results"
               (list internal_operation_result_encoding)
               []);
        select =
          (function
          | Contents_result
              (Manager_operation_result
                ({operation_result = Applied res; _} as op)) -> (
            match res_case.select (Successful_manager_result res) with
            | Some res ->
                Some
                  (Manager_operation_result
                     {op with operation_result = Applied res})
            | None ->
                None )
          | Contents_result
              (Manager_operation_result
                ({operation_result = Backtracked (res, errs); _} as op)) -> (
            match res_case.select (Successful_manager_result res) with
            | Some res ->
                Some
                  (Manager_operation_result
                     {op with operation_result = Backtracked (res, errs)})
            | None ->
                None )
          | Contents_result
              (Manager_operation_result
                ({operation_result = Skipped kind; _} as op)) -> (
            match equal_manager_kind kind res_case.kind with
            | None ->
                None
            | Some Eq ->
                Some
                  (Manager_operation_result
                     {op with operation_result = Skipped kind}) )
          | Contents_result
              (Manager_operation_result
                ({operation_result = Failed (kind, errs); _} as op)) -> (
            match equal_manager_kind kind res_case.kind with
            | None ->
                None
            | Some Eq ->
                Some
                  (Manager_operation_result
                     {op with operation_result = Failed (kind, errs)}) )
          | Contents_result Ballot_result ->
              None
          | Contents_result (Endorsement_result _) ->
              None
          | Contents_result (Seed_nonce_revelation_result _) ->
              None
          | Contents_result (Double_endorsement_evidence_result _) ->
              None
          | Contents_result (Double_baking_evidence_result _) ->
              None
          | Contents_result (Activate_account_result _) ->
              None
          | Contents_result Proposals_result ->
              None);
        mselect;
        proj =
          (fun (Manager_operation_result
                 { balance_updates = bus;
                   operation_result = r;
                   internal_operation_results = rs }) ->
            (bus, r, rs));
        inj =
          (fun (bus, r, rs) ->
            Manager_operation_result
              {
                balance_updates = bus;
                operation_result = r;
                internal_operation_results = rs;
              });
      }

  let reveal_case =
    make_manager_case
      Operation.Encoding.reveal_case
      Manager_result.reveal_case
      (function
        | Contents_and_result
            ((Manager_operation {operation = Reveal _; _} as op), res) ->
            Some (op, res)
        | _ ->
            None)

  let transaction_case =
    make_manager_case
      Operation.Encoding.transaction_case
      Manager_result.transaction_case
      (function
        | Contents_and_result
            ((Manager_operation {operation = Transaction _; _} as op), res) ->
            Some (op, res)
        | _ ->
            None)

  let origination_case =
    make_manager_case
      Operation.Encoding.origination_case
      Manager_result.origination_case
      (function
        | Contents_and_result
            ((Manager_operation {operation = Origination _; _} as op), res) ->
            Some (op, res)
        | _ ->
            None)

  let delegation_case =
    make_manager_case
      Operation.Encoding.delegation_case
      Manager_result.delegation_case
      (function
        | Contents_and_result
            ((Manager_operation {operation = Delegation _; _} as op), res) ->
            Some (op, res)
        | _ ->
            None)
end

let contents_result_encoding =
  let open Encoding in
  let make
      (Case
        { op_case = Operation.Encoding.Case {tag; name; _};
          encoding;
          mselect = _;
          select;
          proj;
          inj }) =
    let proj x =
      match select x with None -> None | Some x -> Some (proj x)
    in
    let inj x = Contents_result (inj x) in
    tagged_case (Tag tag) name encoding proj inj
  in
  def "operation.alpha.contents_result"
  @@ union
       [ make endorsement_case;
         make seed_nonce_revelation_case;
         make double_endorsement_evidence_case;
         make double_baking_evidence_case;
         make activate_account_case;
         make proposals_case;
         make ballot_case;
         make reveal_case;
         make transaction_case;
         make origination_case;
         make delegation_case ]

let contents_and_result_encoding =
  let open Encoding in
  let make
      (Case
        { op_case = Operation.Encoding.Case {tag; name; encoding; proj; inj; _};
          mselect;
          encoding = meta_encoding;
          proj = meta_proj;
          inj = meta_inj;
          _ }) =
    let proj c =
      match mselect c with
      | Some (op, res) ->
          Some (proj op, meta_proj res)
      | _ ->
          None
    in
    let inj (op, res) = Contents_and_result (inj op, meta_inj res) in
    let encoding = merge_objs encoding (obj1 (req "metadata" meta_encoding)) in
    tagged_case (Tag tag) name encoding proj inj
  in
  def "operation.alpha.operation_contents_and_result"
  @@ union
       [ make endorsement_case;
         make seed_nonce_revelation_case;
         make double_endorsement_evidence_case;
         make double_baking_evidence_case;
         make activate_account_case;
         make proposals_case;
         make ballot_case;
         make reveal_case;
         make transaction_case;
         make origination_case;
         make delegation_case ]

type 'kind contents_result_list =
  | Single_result : 'kind contents_result -> 'kind contents_result_list
  | Cons_result :
      'kind Kind.manager contents_result
      * 'rest Kind.manager contents_result_list
      -> ('kind * 'rest) Kind.manager contents_result_list

type packed_contents_result_list =
  | Contents_result_list :
      'kind contents_result_list
      -> packed_contents_result_list

let contents_result_list_encoding =
  let rec to_list = function
    | Contents_result_list (Single_result o) ->
        [Contents_result o]
    | Contents_result_list (Cons_result (o, os)) ->
        Contents_result o :: to_list (Contents_result_list os)
  in
  let rec of_list = function
    | [] ->
        Pervasives.failwith "cannot decode empty operation result"
    | [Contents_result o] ->
        Contents_result_list (Single_result o)
    | Contents_result o :: os -> (
        let (Contents_result_list os) = of_list os in
        match (o, os) with
        | ( Manager_operation_result _,
            Single_result (Manager_operation_result _) ) ->
            Contents_result_list (Cons_result (o, os))
        | (Manager_operation_result _, Cons_result _) ->
            Contents_result_list (Cons_result (o, os))
        | _ ->
            Pervasives.failwith "cannot decode ill-formed operation result" )
  in
  def "operation.alpha.contents_list_result"
  @@ conv to_list of_list (list contents_result_encoding)

type 'kind contents_and_result_list =
  | Single_and_result :
      'kind Alpha_context.contents * 'kind contents_result
      -> 'kind contents_and_result_list
  | Cons_and_result :
      'kind Kind.manager Alpha_context.contents
      * 'kind Kind.manager contents_result
      * 'rest Kind.manager contents_and_result_list
      -> ('kind * 'rest) Kind.manager contents_and_result_list

type packed_contents_and_result_list =
  | Contents_and_result_list :
      'kind contents_and_result_list
      -> packed_contents_and_result_list

let contents_and_result_list_encoding =
  let rec to_list = function
    | Contents_and_result_list (Single_and_result (op, res)) ->
        [Contents_and_result (op, res)]
    | Contents_and_result_list (Cons_and_result (op, res, rest)) ->
        Contents_and_result (op, res)
        :: to_list (Contents_and_result_list rest)
  in
  let rec of_list = function
    | [] ->
        Pervasives.failwith "cannot decode empty combined operation result"
    | [Contents_and_result (op, res)] ->
        Contents_and_result_list (Single_and_result (op, res))
    | Contents_and_result (op, res) :: rest -> (
        let (Contents_and_result_list rest) = of_list rest in
        match (op, rest) with
        | (Manager_operation _, Single_and_result (Manager_operation _, _)) ->
            Contents_and_result_list (Cons_and_result (op, res, rest))
        | (Manager_operation _, Cons_and_result (_, _, _)) ->
            Contents_and_result_list (Cons_and_result (op, res, rest))
        | _ ->
            Pervasives.failwith
              "cannot decode ill-formed combined operation result" )
  in
  conv to_list of_list (Variable.list contents_and_result_encoding)

type 'kind operation_metadata = {contents : 'kind contents_result_list}

type packed_operation_metadata =
  | Operation_metadata : 'kind operation_metadata -> packed_operation_metadata
  | No_operation_metadata : packed_operation_metadata

let operation_metadata_encoding =
  def "operation.alpha.result"
  @@ union
       [ case
           (Tag 0)
           ~title:"Operation_metadata"
           contents_result_list_encoding
           (function
             | Operation_metadata {contents} ->
                 Some (Contents_result_list contents)
             | _ ->
                 None)
           (fun (Contents_result_list contents) ->
             Operation_metadata {contents});
         case
           (Tag 1)
           ~title:"No_operation_metadata"
           empty
           (function No_operation_metadata -> Some () | _ -> None)
           (fun () -> No_operation_metadata) ]

let kind_equal :
    type kind kind2.
    kind contents -> kind2 contents_result -> (kind, kind2) eq option =
 fun op res ->
  match (op, res) with
  | (Endorsement _, Endorsement_result _) ->
      Some Eq
  | (Endorsement _, _) ->
      None
  | (Seed_nonce_revelation _, Seed_nonce_revelation_result _) ->
      Some Eq
  | (Seed_nonce_revelation _, _) ->
      None
  | (Double_endorsement_evidence _, Double_endorsement_evidence_result _) ->
      Some Eq
  | (Double_endorsement_evidence _, _) ->
      None
  | (Double_baking_evidence _, Double_baking_evidence_result _) ->
      Some Eq
  | (Double_baking_evidence _, _) ->
      None
  | (Activate_account _, Activate_account_result _) ->
      Some Eq
  | (Activate_account _, _) ->
      None
  | (Proposals _, Proposals_result) ->
      Some Eq
  | (Proposals _, _) ->
      None
  | (Ballot _, Ballot_result) ->
      Some Eq
  | (Ballot _, _) ->
      None
  | ( Manager_operation {operation = Reveal _; _},
      Manager_operation_result {operation_result = Applied (Reveal_result _); _}
    ) ->
      Some Eq
  | ( Manager_operation {operation = Reveal _; _},
      Manager_operation_result
        {operation_result = Backtracked (Reveal_result _, _); _} ) ->
      Some Eq
  | ( Manager_operation {operation = Reveal _; _},
      Manager_operation_result
        { operation_result = Failed (Alpha_context.Kind.Reveal_manager_kind, _);
          _ } ) ->
      Some Eq
  | ( Manager_operation {operation = Reveal _; _},
      Manager_operation_result
        {operation_result = Skipped Alpha_context.Kind.Reveal_manager_kind; _}
    ) ->
      Some Eq
  | (Manager_operation {operation = Reveal _; _}, _) ->
      None
  | ( Manager_operation {operation = Transaction _; _},
      Manager_operation_result
        {operation_result = Applied (Transaction_result _); _} ) ->
      Some Eq
  | ( Manager_operation {operation = Transaction _; _},
      Manager_operation_result
        {operation_result = Backtracked (Transaction_result _, _); _} ) ->
      Some Eq
  | ( Manager_operation {operation = Transaction _; _},
      Manager_operation_result
        { operation_result =
            Failed (Alpha_context.Kind.Transaction_manager_kind, _);
          _ } ) ->
      Some Eq
  | ( Manager_operation {operation = Transaction _; _},
      Manager_operation_result
        { operation_result = Skipped Alpha_context.Kind.Transaction_manager_kind;
          _ } ) ->
      Some Eq
  | (Manager_operation {operation = Transaction _; _}, _) ->
      None
  | ( Manager_operation {operation = Origination _; _},
      Manager_operation_result
        {operation_result = Applied (Origination_result _); _} ) ->
      Some Eq
  | ( Manager_operation {operation = Origination _; _},
      Manager_operation_result
        {operation_result = Backtracked (Origination_result _, _); _} ) ->
      Some Eq
  | ( Manager_operation {operation = Origination _; _},
      Manager_operation_result
        { operation_result =
            Failed (Alpha_context.Kind.Origination_manager_kind, _);
          _ } ) ->
      Some Eq
  | ( Manager_operation {operation = Origination _; _},
      Manager_operation_result
        { operation_result = Skipped Alpha_context.Kind.Origination_manager_kind;
          _ } ) ->
      Some Eq
  | (Manager_operation {operation = Origination _; _}, _) ->
      None
  | ( Manager_operation {operation = Delegation _; _},
      Manager_operation_result
        {operation_result = Applied (Delegation_result _); _} ) ->
      Some Eq
  | ( Manager_operation {operation = Delegation _; _},
      Manager_operation_result
        {operation_result = Backtracked (Delegation_result _, _); _} ) ->
      Some Eq
  | ( Manager_operation {operation = Delegation _; _},
      Manager_operation_result
        { operation_result =
            Failed (Alpha_context.Kind.Delegation_manager_kind, _);
          _ } ) ->
      Some Eq
  | ( Manager_operation {operation = Delegation _; _},
      Manager_operation_result
        { operation_result = Skipped Alpha_context.Kind.Delegation_manager_kind;
          _ } ) ->
      Some Eq
  | (Manager_operation {operation = Delegation _; _}, _) ->
      None

let rec kind_equal_list :
    type kind kind2.
    kind contents_list -> kind2 contents_result_list -> (kind, kind2) eq option
    =
 fun contents res ->
  match (contents, res) with
  | (Single op, Single_result res) -> (
    match kind_equal op res with None -> None | Some Eq -> Some Eq )
  | (Cons (op, ops), Cons_result (res, ress)) -> (
    match kind_equal op res with
    | None ->
        None
    | Some Eq -> (
      match kind_equal_list ops ress with None -> None | Some Eq -> Some Eq ) )
  | _ ->
      None

let rec pack_contents_list :
    type kind.
    kind contents_list ->
    kind contents_result_list ->
    kind contents_and_result_list =
 fun contents res ->
  match (contents, res) with
  | (Single op, Single_result res) ->
      Single_and_result (op, res)
  | (Cons (op, ops), Cons_result (res, ress)) ->
      Cons_and_result (op, res, pack_contents_list ops ress)
  | ( Single (Manager_operation _),
      Cons_result (Manager_operation_result _, Single_result _) ) ->
      .
  | ( Cons (_, _),
      Single_result (Manager_operation_result {operation_result = Failed _; _})
    ) ->
      .
  | ( Cons (_, _),
      Single_result
        (Manager_operation_result {operation_result = Skipped _; _}) ) ->
      .
  | ( Cons (_, _),
      Single_result
        (Manager_operation_result {operation_result = Applied _; _}) ) ->
      .
  | ( Cons (_, _),
      Single_result
        (Manager_operation_result {operation_result = Backtracked _; _}) ) ->
      .
  | (Single _, Cons_result _) ->
      .

let rec unpack_contents_list :
    type kind.
    kind contents_and_result_list ->
    kind contents_list * kind contents_result_list = function
  | Single_and_result (op, res) ->
      (Single op, Single_result res)
  | Cons_and_result (op, res, rest) ->
      let (ops, ress) = unpack_contents_list rest in
      (Cons (op, ops), Cons_result (res, ress))

let rec to_list = function
  | Contents_result_list (Single_result o) ->
      [Contents_result o]
  | Contents_result_list (Cons_result (o, os)) ->
      Contents_result o :: to_list (Contents_result_list os)

let rec of_list = function
  | [] ->
      assert false
  | [Contents_result o] ->
      Contents_result_list (Single_result o)
  | Contents_result o :: os -> (
      let (Contents_result_list os) = of_list os in
      match (o, os) with
      | (Manager_operation_result _, Single_result (Manager_operation_result _))
        ->
          Contents_result_list (Cons_result (o, os))
      | (Manager_operation_result _, Cons_result _) ->
          Contents_result_list (Cons_result (o, os))
      | _ ->
          Pervasives.failwith
            "Operation result list of length > 1 should only contains manager \
             operations result." )

let operation_data_and_metadata_encoding =
  def "operation.alpha.operation_with_metadata"
  @@ union
       [ case
           (Tag 0)
           ~title:"Operation_with_metadata"
           (obj2
              (req "contents" (dynamic_size contents_and_result_list_encoding))
              (opt "signature" Signature.encoding))
           (function
             | (Operation_data _, No_operation_metadata) ->
                 None
             | (Operation_data op, Operation_metadata res) -> (
               match kind_equal_list op.contents res.contents with
               | None ->
                   Pervasives.failwith
                     "cannot decode inconsistent combined operation result"
               | Some Eq ->
                   Some
                     ( Contents_and_result_list
                         (pack_contents_list op.contents res.contents),
                       op.signature ) ))
           (fun (Contents_and_result_list contents, signature) ->
             let (op_contents, res_contents) = unpack_contents_list contents in
             ( Operation_data {contents = op_contents; signature},
               Operation_metadata {contents = res_contents} ));
         case
           (Tag 1)
           ~title:"Operation_without_metadata"
           (obj2
              (req "contents" (dynamic_size Operation.contents_list_encoding))
              (opt "signature" Signature.encoding))
           (function
             | (Operation_data op, No_operation_metadata) ->
                 Some (Contents_list op.contents, op.signature)
             | (Operation_data _, Operation_metadata _) ->
                 None)
           (fun (Contents_list contents, signature) ->
             (Operation_data {contents; signature}, No_operation_metadata)) ]

type block_metadata = {
  baker : Signature.Public_key_hash.t;
  level : Level.t;
  voting_period_kind : Voting_period.kind;
  nonce_hash : Nonce_hash.t option;
  consumed_gas : Z.t;
  deactivated : Signature.Public_key_hash.t list;
  balance_updates : Delegate.balance_updates;
}

let block_metadata_encoding =
  let open Data_encoding in
  def "block_header.alpha.metadata"
  @@ conv
       (fun { baker;
              level;
              voting_period_kind;
              nonce_hash;
              consumed_gas;
              deactivated;
              balance_updates } ->
         ( baker,
           level,
           voting_period_kind,
           nonce_hash,
           consumed_gas,
           deactivated,
           balance_updates ))
       (fun ( baker,
              level,
              voting_period_kind,
              nonce_hash,
              consumed_gas,
              deactivated,
              balance_updates ) ->
         {
           baker;
           level;
           voting_period_kind;
           nonce_hash;
           consumed_gas;
           deactivated;
           balance_updates;
         })
       (obj7
          (req "baker" Signature.Public_key_hash.encoding)
          (req "level" Level.encoding)
          (req "voting_period_kind" Voting_period.kind_encoding)
          (req "nonce_hash" (option Nonce_hash.encoding))
          (req "consumed_gas" (check_size 10 n))
          (req "deactivated" (list Signature.Public_key_hash.encoding))
          (req "balance_updates" Delegate.balance_updates_encoding))
apply_results_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Import Data_encoding.

Definition error_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    Tezos_protocol_environment_alpha__Environment.Error_monad.error :=
  op_atat
    (let arg :=
      def "error" % string
        (* ❌ expected an argument *)
        expected_argument
        (Some
          "The full list of RPC errors would be too long to include.
It is available at RPC `/errors` (GET).
Errors specific to protocol Alpha have an id that starts with `proto.alpha`."
            % string) in
    fun eta => arg None eta)
    (splitted
      (conv
        (fun err => Data_encoding.Json.construct Error_monad.error_encoding err)
        (fun json => Data_encoding.Json.destruct Error_monad.error_encoding json)
        None json) Error_monad.error_encoding).

Reserved Notation "'successful_manager_operation_result".

Inductive successful_manager_operation_result_gadt : Type :=
| Reveal_result : Tezos_protocol_environment_alpha__Environment.Z.t ->
  successful_manager_operation_result_gadt
| Transaction_result : option Tezos_raw_protocol_alpha.Alpha_context.Script.expr
  -> option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff ->
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  list Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t -> bool ->
  successful_manager_operation_result_gadt
| Origination_result :
  option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff ->
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  list Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  successful_manager_operation_result_gadt
| Delegation_result : Tezos_protocol_environment_alpha__Environment.Z.t ->
  successful_manager_operation_result_gadt

where "'successful_manager_operation_result" := (fun (_ : Type) =>
  successful_manager_operation_result_gadt).

Definition successful_manager_operation_result :=
  'successful_manager_operation_result.

Reserved Notation "'packed_successful_manager_operation_result".

Inductive packed_successful_manager_operation_result_gadt : Type :=
| Successful_manager_result : forall {kind : Type},
  successful_manager_operation_result kind ->
  packed_successful_manager_operation_result_gadt

where "'packed_successful_manager_operation_result" :=
  (packed_successful_manager_operation_result_gadt).

Definition packed_successful_manager_operation_result :=
  'packed_successful_manager_operation_result.

Reserved Notation "'manager_operation_result".

Inductive manager_operation_result_gadt : Type :=
| Applied : forall {kind : Type}, successful_manager_operation_result kind ->
  manager_operation_result_gadt
| Backtracked : forall {kind : Type}, successful_manager_operation_result kind
  ->
  option (list Tezos_protocol_environment_alpha__Environment.Error_monad.error)
  -> manager_operation_result_gadt
| Failed : forall {kind : Type},
  Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind ->
  list Tezos_protocol_environment_alpha__Environment.Error_monad.error ->
  manager_operation_result_gadt
| Skipped : forall {kind : Type},
  Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind ->
  manager_operation_result_gadt

where "'manager_operation_result" := (fun (kind : Type) =>
  manager_operation_result_gadt).

Definition manager_operation_result := 'manager_operation_result.

Reserved Notation "'packed_internal_operation_result".

Inductive packed_internal_operation_result_gadt : Type :=
| Internal_operation_result : forall {kind : Type},
  Tezos_raw_protocol_alpha.Alpha_context.internal_operation kind ->
  manager_operation_result kind -> packed_internal_operation_result_gadt

where "'packed_internal_operation_result" :=
  (packed_internal_operation_result_gadt).

Definition packed_internal_operation_result :=
  'packed_internal_operation_result.

Module Manager_result.
  Reserved Notation "'case".
  
  Inductive case_gadt : Type :=
  | MCase : forall {a kind : Type},
    Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.case
      kind -> Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
    Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind ->
    (packed_internal_operation_result ->
      option
        (Tezos_raw_protocol_alpha.Alpha_context.internal_operation kind *
          manager_operation_result kind)) ->
    (packed_successful_manager_operation_result ->
      option (successful_manager_operation_result kind)) ->
    (successful_manager_operation_result kind -> a) ->
    (a -> successful_manager_operation_result kind) ->
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t
      (manager_operation_result kind) -> case_gadt
  
  where "'case" := (fun (kind : Type) => case_gadt).
  
  Definition case := 'case.
  
  Definition make {A B : Type}
    (op_case :
      Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.case
        A)
    (encoding :
      Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding B)
    (kind : Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A)
    (iselect :
      packed_internal_operation_result ->
        option
          (Tezos_raw_protocol_alpha.Alpha_context.internal_operation A *
            manager_operation_result A))
    (select :
      packed_successful_manager_operation_result ->
        option (successful_manager_operation_result A))
    (proj : successful_manager_operation_result A -> B)
    (inj : B -> successful_manager_operation_result A) : case A :=
    let
      'Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.MCase
        {| name := name |} := op_case in
    let t :=
      op_atat
        (let arg :=
          def
            (Format.asprintf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "operation.alpha.operation_result." % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))
                "operation.alpha.operation_result.%s" % string) name) in
        fun eta => arg None None eta)
        (union
          (Some
            (* ❌ Variants not supported *)
            variant)
          (cons
            (case "Applied" % string None
              (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
              (merge_objs
                (obj1
                  (req None None "status" % string (constant "applied" % string)))
                encoding)
              (fun o =>
                match o with
                | Skipped _ | Failed _ _ | Backtracked _ _ => None
                | Applied o =>
                  match select (Successful_manager_result o) with
                  | None => None
                  | Some o => Some (tt, (proj o))
                  end
                end)
              (fun function_parameter =>
                let '(tt, x) := function_parameter in
                Applied (inj x)))
            (cons
              (case "Failed" % string None
                (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag
                  1)
                (obj2
                  (req None None "status" % string (constant "failed" % string))
                  (req None None "errors" % string (list None error_encoding)))
                (fun function_parameter =>
                  match function_parameter with
                  | Failed _ errs => Some (tt, errs)
                  | _ => None
                  end)
                (fun function_parameter =>
                  let '(tt, errs) := function_parameter in
                  Failed kind errs))
              (cons
                (case "Skipped" % string None
                  (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag
                    2)
                  (obj1
                    (req None None "status" % string
                      (constant "skipped" % string)))
                  (fun function_parameter =>
                    match function_parameter with
                    | Skipped _ => Some tt
                    | _ => None
                    end)
                  (fun function_parameter =>
                    let 'tt := function_parameter in
                    Skipped kind))
                (cons
                  (case "Backtracked" % string None
                    (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag
                      3)
                    (merge_objs
                      (obj2
                        (req None None "status" % string
                          (constant "backtracked" % string))
                        (opt None None "errors" % string
                          (list None error_encoding))) encoding)
                    (fun o =>
                      match o with
                      | Skipped _ | Failed _ _ | Applied _ => None
                      | Backtracked o errs =>
                        match select (Successful_manager_result o) with
                        | None => None
                        | Some o => Some ((tt, errs), (proj o))
                        end
                      end)
                    (fun function_parameter =>
                      let '((tt, errs), x) := function_parameter in
                      Backtracked (inj x) errs)) []))))) in
    MCase
      {| op_case := op_case; encoding := encoding; kind := kind;
        iselect := iselect; select := select; proj := proj; inj := inj; t := t
        |}.
  
  Definition reveal_case
    : case Tezos_raw_protocol_alpha.Alpha_context.Kind.reveal :=
    make Operation.Encoding.Manager_operations.reveal_case
      (obj1 (dft None None "consumed_gas" % string z Z.zero))
      Tezos_raw_protocol_alpha.Alpha_context.Kind.Reveal_manager_kind
      (fun function_parameter =>
        match function_parameter with
        |
          Internal_operation_result
            ({| operation := Tezos_raw_protocol_alpha.Alpha_context.Reveal _ |}
              as op) res => Some (op, res)
        | _ => None
        end)
      (fun function_parameter =>
        match function_parameter with
        | Successful_manager_result ((Reveal_result _) as op) => Some op
        | _ => None
        end)
      (fun function_parameter =>
        let 'Reveal_result {| consumed_gas := consumed_gas |} :=
          function_parameter in
        consumed_gas)
      (fun consumed_gas => Reveal_result {| consumed_gas := consumed_gas |}).
  
  Definition transaction_case
    : case Tezos_raw_protocol_alpha.Alpha_context.Kind.transaction :=
    make Operation.Encoding.Manager_operations.transaction_case
      (obj8 (opt None None "storage" % string Script.expr_encoding)
        (opt None None "big_map_diff" % string Contract.big_map_diff_encoding)
        (dft None None "balance_updates" % string
          Delegate.balance_updates_encoding [])
        (dft None None "originated_contracts" % string
          (list None Contract.encoding) [])
        (dft None None "consumed_gas" % string z Z.zero)
        (dft None None "storage_size" % string z Z.zero)
        (dft None None "paid_storage_size_diff" % string z Z.zero)
        (dft None None "allocated_destination_contract" % string bool false))
      Tezos_raw_protocol_alpha.Alpha_context.Kind.Transaction_manager_kind
      (fun function_parameter =>
        match function_parameter with
        |
          Internal_operation_result
            ({|
              operation := Tezos_raw_protocol_alpha.Alpha_context.Transaction _
                |} as op) res => Some (op, res)
        | _ => None
        end)
      (fun function_parameter =>
        match function_parameter with
        | Successful_manager_result ((Transaction_result _) as op) => Some op
        | _ => None
        end)
      (fun function_parameter =>
        let
          'Transaction_result {|
            storage := storage;
              big_map_diff := big_map_diff;
              balance_updates := balance_updates;
              originated_contracts := originated_contracts;
              consumed_gas := consumed_gas;
              storage_size := storage_size;
              paid_storage_size_diff := paid_storage_size_diff;
              allocated_destination_contract := allocated_destination_contract
              |} := function_parameter in
        (storage, big_map_diff, balance_updates, originated_contracts,
          consumed_gas, storage_size, paid_storage_size_diff,
          allocated_destination_contract))
      (fun function_parameter =>
        let
          '(storage, big_map_diff, balance_updates, originated_contracts,
            consumed_gas, storage_size, paid_storage_size_diff,
            allocated_destination_contract) := function_parameter in
        Transaction_result
          {| storage := storage; big_map_diff := big_map_diff;
            balance_updates := balance_updates;
            originated_contracts := originated_contracts;
            consumed_gas := consumed_gas; storage_size := storage_size;
            paid_storage_size_diff := paid_storage_size_diff;
            allocated_destination_contract := allocated_destination_contract |}).
  
  Definition origination_case
    : case Tezos_raw_protocol_alpha.Alpha_context.Kind.origination :=
    make Operation.Encoding.Manager_operations.origination_case
      (obj6
        (opt None None "big_map_diff" % string Contract.big_map_diff_encoding)
        (dft None None "balance_updates" % string
          Delegate.balance_updates_encoding [])
        (dft None None "originated_contracts" % string
          (list None Contract.encoding) [])
        (dft None None "consumed_gas" % string z Z.zero)
        (dft None None "storage_size" % string z Z.zero)
        (dft None None "paid_storage_size_diff" % string z Z.zero))
      Tezos_raw_protocol_alpha.Alpha_context.Kind.Origination_manager_kind
      (fun function_parameter =>
        match function_parameter with
        |
          Internal_operation_result
            ({|
              operation := Tezos_raw_protocol_alpha.Alpha_context.Origination _
                |} as op) res => Some (op, res)
        | _ => None
        end)
      (fun function_parameter =>
        match function_parameter with
        | Successful_manager_result ((Origination_result _) as op) => Some op
        | _ => None
        end)
      (fun function_parameter =>
        let
          'Origination_result {|
            big_map_diff := big_map_diff;
              balance_updates := balance_updates;
              originated_contracts := originated_contracts;
              consumed_gas := consumed_gas;
              storage_size := storage_size;
              paid_storage_size_diff := paid_storage_size_diff
              |} := function_parameter in
        (big_map_diff, balance_updates, originated_contracts, consumed_gas,
          storage_size, paid_storage_size_diff))
      (fun function_parameter =>
        let
          '(big_map_diff, balance_updates, originated_contracts, consumed_gas,
            storage_size, paid_storage_size_diff) := function_parameter in
        Origination_result
          {| big_map_diff := big_map_diff; balance_updates := balance_updates;
            originated_contracts := originated_contracts;
            consumed_gas := consumed_gas; storage_size := storage_size;
            paid_storage_size_diff := paid_storage_size_diff |}).
  
  Definition delegation_case
    : case Tezos_raw_protocol_alpha.Alpha_context.Kind.delegation :=
    make Operation.Encoding.Manager_operations.delegation_case
      (obj1 (dft None None "consumed_gas" % string z Z.zero))
      Tezos_raw_protocol_alpha.Alpha_context.Kind.Delegation_manager_kind
      (fun function_parameter =>
        match function_parameter with
        |
          Internal_operation_result
            ({|
              operation := Tezos_raw_protocol_alpha.Alpha_context.Delegation _
                |} as op) res => Some (op, res)
        | _ => None
        end)
      (fun function_parameter =>
        match function_parameter with
        | Successful_manager_result ((Delegation_result _) as op) => Some op
        | _ => None
        end)
      (fun function_parameter =>
        let 'Delegation_result {| consumed_gas := consumed_gas |} :=
          function_parameter in
        consumed_gas)
      (fun consumed_gas => Delegation_result {| consumed_gas := consumed_gas |}).
End Manager_result.

Definition internal_operation_result_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    packed_internal_operation_result :=
  let make {A : Type} (function_parameter : Manager_result.case A)
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.case
      packed_internal_operation_result :=
    let 'Manager_result.MCase res_case := function_parameter in
    let
      'Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Manager_operations.MCase
        op_case := op_case res_case in
    case (name op_case) None
      (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag
        (tag op_case))
      (merge_objs
        (obj3 (req None None "kind" % string (constant (name op_case)))
          (req None None "source" % string Contract.encoding)
          (req None None "nonce" % string uint16))
        (merge_objs (encoding op_case)
          (obj1 (req None None "result" % string (t res_case)))))
      (fun op =>
        match (iselect res_case) op with
        | Some (op, res) =>
          Some
            ((tt, (source op), (nonce op)),
              (((proj op_case) (operation op)), res))
        | None => None
        end)
      (fun function_parameter =>
        let '((tt, source, nonce), (op, res)) := function_parameter in
        let op :=
          {| source := source; operation := (inj op_case) op; nonce := nonce |}
          in
        Internal_operation_result op res) in
  op_atat
    (let arg := def "operation.alpha.internal_operation_result" % string in
    fun eta => arg None None eta)
    (union None
      (cons (make Manager_result.reveal_case)
        (cons (make Manager_result.transaction_case)
          (cons (make Manager_result.origination_case)
            (cons (make Manager_result.delegation_case) []))))).

Reserved Notation "'contents_result".

Inductive contents_result_gadt : Type :=
| Endorsement_result :
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  list Z -> contents_result_gadt
| Seed_nonce_revelation_result :
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  contents_result_gadt
| Double_endorsement_evidence_result :
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  contents_result_gadt
| Double_baking_evidence_result :
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  contents_result_gadt
| Activate_account_result :
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  contents_result_gadt
| Proposals_result : contents_result_gadt
| Ballot_result : contents_result_gadt
| Manager_operation_result : forall {kind : Type},
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  manager_operation_result kind -> list packed_internal_operation_result ->
  contents_result_gadt

where "'contents_result" := (fun (kind : Type) => contents_result_gadt).

Definition contents_result := 'contents_result.

Reserved Notation "'packed_contents_result".

Inductive packed_contents_result_gadt : Type :=
| Contents_result : forall {kind : Type}, contents_result kind ->
  packed_contents_result_gadt

where "'packed_contents_result" := (packed_contents_result_gadt).

Definition packed_contents_result := 'packed_contents_result.

Reserved Notation "'packed_contents_and_result".

Inductive packed_contents_and_result_gadt : Type :=
| Contents_and_result : forall {kind : Type},
  Tezos_raw_protocol_alpha.Alpha_context.Operation.contents kind ->
  contents_result kind -> packed_contents_and_result_gadt

where "'packed_contents_and_result" := (packed_contents_and_result_gadt).

Definition packed_contents_and_result := 'packed_contents_and_result.

Reserved Notation "'eq".

Inductive eq_gadt : Type :=
| Eq : eq_gadt

where "'eq" := (fun (a b : Type) => eq_gadt).

Definition eq := 'eq.

Definition equal_manager_kind {a b : Type}
  (ka : Tezos_raw_protocol_alpha.Alpha_context.Kind.manager a)
  (kb : Tezos_raw_protocol_alpha.Alpha_context.Kind.manager b)
  : option (eq a b) :=
  match (ka, kb) with
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Kind.Reveal_manager_kind,
      Tezos_raw_protocol_alpha.Alpha_context.Kind.Reveal_manager_kind) =>
    Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Kind.Reveal_manager_kind, _) => None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Kind.Transaction_manager_kind,
      Tezos_raw_protocol_alpha.Alpha_context.Kind.Transaction_manager_kind) =>
    Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Kind.Transaction_manager_kind, _) =>
    None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Kind.Origination_manager_kind,
      Tezos_raw_protocol_alpha.Alpha_context.Kind.Origination_manager_kind) =>
    Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Kind.Origination_manager_kind, _) =>
    None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Kind.Delegation_manager_kind,
      Tezos_raw_protocol_alpha.Alpha_context.Kind.Delegation_manager_kind) =>
    Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Kind.Delegation_manager_kind, _) =>
    None
  end.

Module Encoding.
  Reserved Notation "'case".
  
  Inductive case_gadt : Type :=
  | Case : forall {a kind : Type},
    Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.case kind ->
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
    (packed_contents_result -> option (contents_result kind)) ->
    (packed_contents_and_result ->
      option
        (Tezos_raw_protocol_alpha.Alpha_context.contents kind *
          contents_result kind)) -> (contents_result kind -> a) ->
    (a -> contents_result kind) -> case_gadt
  
  where "'case" := (fun (kind : Type) => case_gadt).
  
  Definition case := 'case.
  
  Definition tagged_case {A B : Type}
    (tag : Tezos_protocol_environment_alpha__Environment.Data_encoding.case_tag)
    (name : string)
    (args :
      Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding A)
    (proj : B -> option A) (inj : A -> B)
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.case B :=
    case (String.capitalize_ascii name) None tag
      (merge_objs (obj1 (req None None "kind" % string (constant name))) args)
      (fun x =>
        match proj x with
        | None => None
        | Some x => Some (tt, x)
        end)
      (fun function_parameter =>
        let '(tt, x) := function_parameter in
        inj x).
  
  Definition endorsement_case
    : case Tezos_raw_protocol_alpha.Alpha_context.Kind.endorsement :=
    Case
      {| op_case := Operation.Encoding.endorsement_case;
        encoding :=
          obj3
            (req None None "balance_updates" % string
              Delegate.balance_updates_encoding)
            (req None None "delegate" % string
              Signature.Public_key_hash.encoding)
            (req None None "slots" % string (list None uint8));
        select :=
          fun function_parameter =>
            match function_parameter with
            | Contents_result ((Endorsement_result _) as op) => Some op
            | _ => None
            end;
        mselect :=
          fun function_parameter =>
            match function_parameter with
            |
              Contents_and_result
                ((Tezos_raw_protocol_alpha.Alpha_context.Endorsement _) as op)
                res => Some (op, res)
            | _ => None
            end;
        proj :=
          fun function_parameter =>
            let
              'Endorsement_result {|
                balance_updates := balance_updates;
                  delegate := delegate;
                  slots := slots
                  |} := function_parameter in
            (balance_updates, delegate, slots);
        inj :=
          fun function_parameter =>
            let '(balance_updates, delegate, slots) := function_parameter in
            Endorsement_result
              {| balance_updates := balance_updates; delegate := delegate;
                slots := slots |} |}.
  
  Definition seed_nonce_revelation_case
    : case Tezos_raw_protocol_alpha.Alpha_context.Kind.seed_nonce_revelation :=
    Case
      {| op_case := Operation.Encoding.seed_nonce_revelation_case;
        encoding :=
          obj1
            (req None None "balance_updates" % string
              Delegate.balance_updates_encoding);
        select :=
          fun function_parameter =>
            match function_parameter with
            | Contents_result ((Seed_nonce_revelation_result _) as op) =>
              Some op
            | _ => None
            end;
        mselect :=
          fun function_parameter =>
            match function_parameter with
            |
              Contents_and_result
                ((Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation _)
                  as op) res => Some (op, res)
            | _ => None
            end;
        proj :=
          fun function_parameter =>
            let 'Seed_nonce_revelation_result bus := function_parameter in
            bus; inj := fun bus => Seed_nonce_revelation_result bus |}.
  
  Definition double_endorsement_evidence_case
    : case
      Tezos_raw_protocol_alpha.Alpha_context.Kind.double_endorsement_evidence :=
    Case
      {| op_case := Operation.Encoding.double_endorsement_evidence_case;
        encoding :=
          obj1
            (req None None "balance_updates" % string
              Delegate.balance_updates_encoding);
        select :=
          fun function_parameter =>
            match function_parameter with
            | Contents_result ((Double_endorsement_evidence_result _) as op) =>
              Some op
            | _ => None
            end;
        mselect :=
          fun function_parameter =>
            match function_parameter with
            |
              Contents_and_result
                ((Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence
                  _) as op) res => Some (op, res)
            | _ => None
            end;
        proj :=
          fun function_parameter =>
            let 'Double_endorsement_evidence_result bus := function_parameter in
            bus; inj := fun bus => Double_endorsement_evidence_result bus |}.
  
  Definition double_baking_evidence_case
    : case Tezos_raw_protocol_alpha.Alpha_context.Kind.double_baking_evidence :=
    Case
      {| op_case := Operation.Encoding.double_baking_evidence_case;
        encoding :=
          obj1
            (req None None "balance_updates" % string
              Delegate.balance_updates_encoding);
        select :=
          fun function_parameter =>
            match function_parameter with
            | Contents_result ((Double_baking_evidence_result _) as op) =>
              Some op
            | _ => None
            end;
        mselect :=
          fun function_parameter =>
            match function_parameter with
            |
              Contents_and_result
                ((Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence
                  _) as op) res => Some (op, res)
            | _ => None
            end;
        proj :=
          fun function_parameter =>
            let 'Double_baking_evidence_result bus := function_parameter in
            bus; inj := fun bus => Double_baking_evidence_result bus |}.
  
  Definition activate_account_case
    : case Tezos_raw_protocol_alpha.Alpha_context.Kind.activate_account :=
    Case
      {| op_case := Operation.Encoding.activate_account_case;
        encoding :=
          obj1
            (req None None "balance_updates" % string
              Delegate.balance_updates_encoding);
        select :=
          fun function_parameter =>
            match function_parameter with
            | Contents_result ((Activate_account_result _) as op) => Some op
            | _ => None
            end;
        mselect :=
          fun function_parameter =>
            match function_parameter with
            |
              Contents_and_result
                ((Tezos_raw_protocol_alpha.Alpha_context.Activate_account _) as
                  op) res => Some (op, res)
            | _ => None
            end;
        proj :=
          fun function_parameter =>
            let 'Activate_account_result bus := function_parameter in
            bus; inj := fun bus => Activate_account_result bus |}.
  
  Definition proposals_case
    : case Tezos_raw_protocol_alpha__Alpha_context.Kind.proposals :=
    Case
      {| op_case := Operation.Encoding.proposals_case;
        encoding := Data_encoding.empty;
        select :=
          fun function_parameter =>
            match function_parameter with
            | Contents_result (Proposals_result as op) => Some op
            | _ => None
            end;
        mselect :=
          fun function_parameter =>
            match function_parameter with
            |
              Contents_and_result
                ((Tezos_raw_protocol_alpha.Alpha_context.Proposals _) as op) res
              => Some (op, res)
            | _ => None
            end;
        proj :=
          fun function_parameter =>
            let 'Proposals_result := function_parameter in
            tt;
        inj :=
          fun function_parameter =>
            let 'tt := function_parameter in
            Proposals_result |}.
  
  Definition ballot_case
    : case Tezos_raw_protocol_alpha__Alpha_context.Kind.ballot :=
    Case
      {| op_case := Operation.Encoding.ballot_case;
        encoding := Data_encoding.empty;
        select :=
          fun function_parameter =>
            match function_parameter with
            | Contents_result (Ballot_result as op) => Some op
            | _ => None
            end;
        mselect :=
          fun function_parameter =>
            match function_parameter with
            |
              Contents_and_result
                ((Tezos_raw_protocol_alpha.Alpha_context.Ballot _) as op) res =>
              Some (op, res)
            | _ => None
            end;
        proj :=
          fun function_parameter =>
            let 'Ballot_result := function_parameter in
            tt;
        inj :=
          fun function_parameter =>
            let 'tt := function_parameter in
            Ballot_result |}.
  
  Definition make_manager_case {A : Type}
    (function_parameter :
      Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.case
        (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A))
    : Manager_result.case A ->
      (packed_contents_and_result ->
        option
          (Tezos_raw_protocol_alpha.Alpha_context.contents
            (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A) *
            contents_result
              (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A))) ->
        case (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A) :=
    let
      'Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Case op_case :=
      function_parameter in
    fun function_parameter =>
      let 'Manager_result.MCase res_case := function_parameter in
      fun mselect =>
        Case
          {|
            op_case :=
              Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Case
                op_case;
            encoding :=
              obj3
                (req None None "balance_updates" % string
                  Delegate.balance_updates_encoding)
                (req None None "operation_result" % string (t res_case))
                (dft None None "internal_operation_results" % string
                  (list None internal_operation_result_encoding) []);
            select :=
              fun function_parameter =>
                match function_parameter with
                |
                  Contents_result
                    (Manager_operation_result
                      ({| operation_result := Applied res |} as op)) =>
                  match (select res_case) (Successful_manager_result res) with
                  | Some res =>
                    Some
                      (Manager_operation_result
                        (* ❌ Record substitution not handled *)
                        record_substitution)
                  | None => None
                  end
                |
                  Contents_result
                    (Manager_operation_result
                      ({| operation_result := Backtracked res errs |} as op)) =>
                  match (select res_case) (Successful_manager_result res) with
                  | Some res =>
                    Some
                      (Manager_operation_result
                        (* ❌ Record substitution not handled *)
                        record_substitution)
                  | None => None
                  end
                |
                  Contents_result
                    (Manager_operation_result
                      ({| operation_result := Skipped kind |} as op)) =>
                  match equal_manager_kind kind (kind res_case) with
                  | None => None
                  | Some Eq =>
                    Some
                      (Manager_operation_result
                        (* ❌ Record substitution not handled *)
                        record_substitution)
                  end
                |
                  Contents_result
                    (Manager_operation_result
                      ({| operation_result := Failed kind errs |} as op)) =>
                  match equal_manager_kind kind (kind res_case) with
                  | None => None
                  | Some Eq =>
                    Some
                      (Manager_operation_result
                        (* ❌ Record substitution not handled *)
                        record_substitution)
                  end
                | Contents_result Ballot_result => None
                | Contents_result (Endorsement_result _) => None
                | Contents_result (Seed_nonce_revelation_result _) => None
                | Contents_result (Double_endorsement_evidence_result _) => None
                | Contents_result (Double_baking_evidence_result _) => None
                | Contents_result (Activate_account_result _) => None
                | Contents_result Proposals_result => None
                end; mselect := mselect;
            proj :=
              fun function_parameter =>
                let
                  'Manager_operation_result {|
                    balance_updates := bus;
                      operation_result := r;
                      internal_operation_results := rs
                      |} := function_parameter in
                (bus, r, rs);
            inj :=
              fun function_parameter =>
                let '(bus, r, rs) := function_parameter in
                Manager_operation_result
                  {| balance_updates := bus; operation_result := r;
                    internal_operation_results := rs |} |}.
  
  Definition reveal_case
    : case
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager
        Tezos_raw_protocol_alpha.Alpha_context.Kind.reveal) :=
    make_manager_case Operation.Encoding.reveal_case Manager_result.reveal_case
      (fun function_parameter =>
        match function_parameter with
        |
          Contents_and_result
            ((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
              operation := Tezos_raw_protocol_alpha.Alpha_context.Reveal _
                |}) as op) res => Some (op, res)
        | _ => None
        end).
  
  Definition transaction_case
    : case
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager
        Tezos_raw_protocol_alpha.Alpha_context.Kind.transaction) :=
    make_manager_case Operation.Encoding.transaction_case
      Manager_result.transaction_case
      (fun function_parameter =>
        match function_parameter with
        |
          Contents_and_result
            ((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
              operation := Tezos_raw_protocol_alpha.Alpha_context.Transaction _
                |}) as op) res => Some (op, res)
        | _ => None
        end).
  
  Definition origination_case
    : case
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager
        Tezos_raw_protocol_alpha.Alpha_context.Kind.origination) :=
    make_manager_case Operation.Encoding.origination_case
      Manager_result.origination_case
      (fun function_parameter =>
        match function_parameter with
        |
          Contents_and_result
            ((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
              operation := Tezos_raw_protocol_alpha.Alpha_context.Origination _
                |}) as op) res => Some (op, res)
        | _ => None
        end).
  
  Definition delegation_case
    : case
      (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager
        Tezos_raw_protocol_alpha.Alpha_context.Kind.delegation) :=
    make_manager_case Operation.Encoding.delegation_case
      Manager_result.delegation_case
      (fun function_parameter =>
        match function_parameter with
        |
          Contents_and_result
            ((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
              operation := Tezos_raw_protocol_alpha.Alpha_context.Delegation _
                |}) as op) res => Some (op, res)
        | _ => None
        end).
End Encoding.

Definition contents_result_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    packed_contents_result :=
  let make {A : Type} (function_parameter : Encoding.case A)
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.case
      packed_contents_result :=
    let
      'Encoding.Case {|
        op_case :=
          Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Case {|
            tag := tag; name := name |};
          encoding := encoding;
          select := select;
          mselect := _;
          proj := proj;
          inj := inj
          |} := function_parameter in
    let proj (x : packed_contents_result) : option op_dollarCase_'a :=
      match select x with
      | None => None
      | Some x => Some (proj x)
      end in
    let inj (x : op_dollarCase_'a) : packed_contents_result :=
      Contents_result (inj x) in
    tagged_case
      (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag tag) name
      encoding proj inj in
  op_atat
    (let arg := def "operation.alpha.contents_result" % string in
    fun eta => arg None None eta)
    (union None
      (cons (make endorsement_case)
        (cons (make seed_nonce_revelation_case)
          (cons (make double_endorsement_evidence_case)
            (cons (make double_baking_evidence_case)
              (cons (make activate_account_case)
                (cons (make proposals_case)
                  (cons (make ballot_case)
                    (cons (make reveal_case)
                      (cons (make transaction_case)
                        (cons (make origination_case)
                          (cons (make delegation_case) [])))))))))))).

Definition contents_and_result_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    packed_contents_and_result :=
  let make {A : Type} (function_parameter : Encoding.case A)
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.case
      packed_contents_and_result :=
    let
      'Encoding.Case {|
        op_case :=
          Tezos_raw_protocol_alpha.Alpha_context.Operation.Encoding.Case {|
            tag := tag;
              name := name;
              encoding := encoding;
              proj := proj;
              inj := inj
              |};
          encoding := meta_encoding;
          mselect := mselect;
          proj := meta_proj;
          inj := meta_inj
          |} := function_parameter in
    let proj (c : packed_contents_and_result)
      : option (op_dollarCase_'a1 * op_dollarCase_'a) :=
      match mselect c with
      | Some (op, res) => Some ((proj op), (meta_proj res))
      | _ => None
      end in
    let inj (function_parameter : op_dollarCase_'a1 * op_dollarCase_'a)
      : packed_contents_and_result :=
      let '(op, res) := function_parameter in
      Contents_and_result (inj op) (meta_inj res) in
    let encoding :=
      merge_objs encoding
        (obj1 (req None None "metadata" % string meta_encoding)) in
    tagged_case
      (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag tag) name
      encoding proj inj in
  op_atat
    (let arg := def "operation.alpha.operation_contents_and_result" % string in
    fun eta => arg None None eta)
    (union None
      (cons (make endorsement_case)
        (cons (make seed_nonce_revelation_case)
          (cons (make double_endorsement_evidence_case)
            (cons (make double_baking_evidence_case)
              (cons (make activate_account_case)
                (cons (make proposals_case)
                  (cons (make ballot_case)
                    (cons (make reveal_case)
                      (cons (make transaction_case)
                        (cons (make origination_case)
                          (cons (make delegation_case) [])))))))))))).

Reserved Notation "'contents_result_list".

Inductive contents_result_list_gadt : Type :=
| Single_result : forall {kind : Type}, contents_result kind ->
  contents_result_list_gadt
| Cons_result : forall {kind : Type},
  contents_result (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) ->
  contents_result_list_gadt -> contents_result_list_gadt

where "'contents_result_list" := (fun (kind : Type) =>
  contents_result_list_gadt).

Definition contents_result_list := 'contents_result_list.

Reserved Notation "'packed_contents_result_list".

Inductive packed_contents_result_list_gadt : Type :=
| Contents_result_list : forall {kind : Type}, contents_result_list kind ->
  packed_contents_result_list_gadt

where "'packed_contents_result_list" := (packed_contents_result_list_gadt).

Definition packed_contents_result_list := 'packed_contents_result_list.

Definition contents_result_list_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    packed_contents_result_list :=
  let fix to_list (function_parameter : packed_contents_result_list)
    : list packed_contents_result :=
    match function_parameter with
    | Contents_result_list (Single_result o) => cons (Contents_result o) []
    | Contents_result_list (Cons_result o os) =>
      cons (Contents_result o) (to_list (Contents_result_list os))
    end in
  let fix of_list (function_parameter : list packed_contents_result)
    : packed_contents_result_list :=
    match function_parameter with
    | [] => Pervasives.failwith "cannot decode empty operation result" % string
    | cons (Contents_result o) [] => Contents_result_list (Single_result o)
    | cons (Contents_result o) os =>
      let 'Contents_result_list os := of_list os in
      match (o, os) with
      | (Manager_operation_result _, Single_result (Manager_operation_result _))
        => Contents_result_list (Cons_result o os)
      | (Manager_operation_result _, Cons_result _ _) =>
        Contents_result_list (Cons_result o os)
      | _ =>
        Pervasives.failwith "cannot decode ill-formed operation result" % string
      end
    end in
  op_atat
    (let arg := def "operation.alpha.contents_list_result" % string in
    fun eta => arg None None eta)
    (conv to_list of_list None (list None contents_result_encoding)).

Reserved Notation "'contents_and_result_list".

Inductive contents_and_result_list_gadt : Type :=
| Single_and_result : forall {kind : Type},
  Tezos_raw_protocol_alpha.Alpha_context.contents kind -> contents_result kind
  -> contents_and_result_list_gadt
| Cons_and_result : forall {kind : Type},
  Tezos_raw_protocol_alpha.Alpha_context.contents
    (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) ->
  contents_result (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) ->
  contents_and_result_list_gadt -> contents_and_result_list_gadt

where "'contents_and_result_list" := (fun (kind : Type) =>
  contents_and_result_list_gadt).

Definition contents_and_result_list := 'contents_and_result_list.

Reserved Notation "'packed_contents_and_result_list".

Inductive packed_contents_and_result_list_gadt : Type :=
| Contents_and_result_list : forall {kind : Type}, contents_and_result_list kind
  -> packed_contents_and_result_list_gadt

where "'packed_contents_and_result_list" :=
  (packed_contents_and_result_list_gadt).

Definition packed_contents_and_result_list := 'packed_contents_and_result_list.

Definition contents_and_result_list_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    packed_contents_and_result_list :=
  let fix to_list (function_parameter : packed_contents_and_result_list)
    : list packed_contents_and_result :=
    match function_parameter with
    | Contents_and_result_list (Single_and_result op res) =>
      cons (Contents_and_result op res) []
    | Contents_and_result_list (Cons_and_result op res rest) =>
      cons (Contents_and_result op res)
        (to_list (Contents_and_result_list rest))
    end in
  let fix of_list (function_parameter : list packed_contents_and_result)
    : packed_contents_and_result_list :=
    match function_parameter with
    | [] =>
      Pervasives.failwith
        "cannot decode empty combined operation result" % string
    | cons (Contents_and_result op res) [] =>
      Contents_and_result_list (Single_and_result op res)
    | cons (Contents_and_result op res) rest =>
      let 'Contents_and_result_list rest := of_list rest in
      match (op, rest) with
      |
        (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _,
          Single_and_result
            (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _) _) =>
        Contents_and_result_list (Cons_and_result op res rest)
      |
        (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _,
          Cons_and_result _ _ _) =>
        Contents_and_result_list (Cons_and_result op res rest)
      | _ =>
        Pervasives.failwith
          "cannot decode ill-formed combined operation result" % string
      end
    end in
  conv to_list of_list None (Variable.list None contents_and_result_encoding).

Record operation_metadata {kind : Type} := {
  contents : contents_result_list kind }.
Arguments operation_metadata : clear implicits.

Reserved Notation "'packed_operation_metadata".

Inductive packed_operation_metadata_gadt : Type :=
| Operation_metadata : forall {kind : Type}, operation_metadata kind ->
  packed_operation_metadata_gadt
| No_operation_metadata : packed_operation_metadata_gadt

where "'packed_operation_metadata" := (packed_operation_metadata_gadt).

Definition packed_operation_metadata := 'packed_operation_metadata.

Definition operation_metadata_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    packed_operation_metadata :=
  op_atat
    (let arg := def "operation.alpha.result" % string in
    fun eta => arg None None eta)
    (union None
      (cons
        (case "Operation_metadata" % string None
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
          contents_result_list_encoding
          (fun function_parameter =>
            match function_parameter with
            | Operation_metadata {| contents := contents |} =>
              Some (Contents_result_list contents)
            | _ => None
            end)
          (fun function_parameter =>
            let 'Contents_result_list contents := function_parameter in
            Operation_metadata {| contents := contents |}))
        (cons
          (case "No_operation_metadata" % string None
            (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
            empty
            (fun function_parameter =>
              match function_parameter with
              | No_operation_metadata => Some tt
              | _ => None
              end)
            (fun function_parameter =>
              let 'tt := function_parameter in
              No_operation_metadata)) []))).

Definition kind_equal {kind kind2 : Type}
  (op : Tezos_raw_protocol_alpha.Alpha_context.contents kind)
  (res : contents_result kind2) : option (eq kind kind2) :=
  match (op, res) with
  | (Tezos_raw_protocol_alpha.Alpha_context.Endorsement _, Endorsement_result _)
    => Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Endorsement _, _) => None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation _,
      Seed_nonce_revelation_result _) => Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation _, _) => None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence _,
      Double_endorsement_evidence_result _) => Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence _, _) =>
    None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence _,
      Double_baking_evidence_result _) => Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence _, _) => None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Activate_account _,
      Activate_account_result _) => Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Activate_account _, _) => None
  | (Tezos_raw_protocol_alpha.Alpha_context.Proposals _, Proposals_result) =>
    Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Proposals _, _) => None
  | (Tezos_raw_protocol_alpha.Alpha_context.Ballot _, Ballot_result) => Some Eq
  | (Tezos_raw_protocol_alpha.Alpha_context.Ballot _, _) => None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      operation := Tezos_raw_protocol_alpha.Alpha_context.Reveal _ |},
      Manager_operation_result {|
        operation_result := Applied (Reveal_result _) |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      operation := Tezos_raw_protocol_alpha.Alpha_context.Reveal _ |},
      Manager_operation_result {|
        operation_result := Backtracked (Reveal_result _) _ |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      operation := Tezos_raw_protocol_alpha.Alpha_context.Reveal _ |},
      Manager_operation_result {|
        operation_result :=
          Failed Tezos_raw_protocol_alpha.Alpha_context.Kind.Reveal_manager_kind
            _
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      operation := Tezos_raw_protocol_alpha.Alpha_context.Reveal _ |},
      Manager_operation_result {|
        operation_result :=
          Skipped
            Tezos_raw_protocol_alpha.Alpha_context.Kind.Reveal_manager_kind
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      operation := Tezos_raw_protocol_alpha.Alpha_context.Reveal _ |}, _) =>
    None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      operation := Tezos_raw_protocol_alpha.Alpha_context.Transaction _ |},
      Manager_operation_result {|
        operation_result := Applied (Transaction_result _) |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      operation := Tezos_raw_protocol_alpha.Alpha_context.Transaction _ |},
      Manager_operation_result {|
        operation_result := Backtracked (Transaction_result _) _ |}) =>
    Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      operation := Tezos_raw_protocol_alpha.Alpha_context.Transaction _ |},
      Manager_operation_result {|
        operation_result :=
          Failed
            Tezos_raw_protocol_alpha.Alpha_context.Kind.Transaction_manager_kind
            _
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      operation := Tezos_raw_protocol_alpha.Alpha_context.Transaction _ |},
      Manager_operation_result {|
        operation_result :=
          Skipped
            Tezos_raw_protocol_alpha.Alpha_context.Kind.Transaction_manager_kind
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      operation := Tezos_raw_protocol_alpha.Alpha_context.Transaction _ |},
      _) => None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      operation := Tezos_raw_protocol_alpha.Alpha_context.Origination _ |},
      Manager_operation_result {|
        operation_result := Applied (Origination_result _) |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      operation := Tezos_raw_protocol_alpha.Alpha_context.Origination _ |},
      Manager_operation_result {|
        operation_result := Backtracked (Origination_result _) _ |}) =>
    Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      operation := Tezos_raw_protocol_alpha.Alpha_context.Origination _ |},
      Manager_operation_result {|
        operation_result :=
          Failed
            Tezos_raw_protocol_alpha.Alpha_context.Kind.Origination_manager_kind
            _
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      operation := Tezos_raw_protocol_alpha.Alpha_context.Origination _ |},
      Manager_operation_result {|
        operation_result :=
          Skipped
            Tezos_raw_protocol_alpha.Alpha_context.Kind.Origination_manager_kind
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      operation := Tezos_raw_protocol_alpha.Alpha_context.Origination _ |},
      _) => None
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      operation := Tezos_raw_protocol_alpha.Alpha_context.Delegation _ |},
      Manager_operation_result {|
        operation_result := Applied (Delegation_result _) |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      operation := Tezos_raw_protocol_alpha.Alpha_context.Delegation _ |},
      Manager_operation_result {|
        operation_result := Backtracked (Delegation_result _) _ |}) =>
    Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      operation := Tezos_raw_protocol_alpha.Alpha_context.Delegation _ |},
      Manager_operation_result {|
        operation_result :=
          Failed
            Tezos_raw_protocol_alpha.Alpha_context.Kind.Delegation_manager_kind
            _
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      operation := Tezos_raw_protocol_alpha.Alpha_context.Delegation _ |},
      Manager_operation_result {|
        operation_result :=
          Skipped
            Tezos_raw_protocol_alpha.Alpha_context.Kind.Delegation_manager_kind
          |}) => Some Eq
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
      operation := Tezos_raw_protocol_alpha.Alpha_context.Delegation _ |}, _)
    => None
  end.

Fixpoint kind_equal_list {kind kind2 : Type}
  (contents : Tezos_raw_protocol_alpha.Alpha_context.contents_list kind)
  (res : contents_result_list kind2) : option (eq kind kind2) :=
  match (contents, res) with
  | (Tezos_raw_protocol_alpha.Alpha_context.Single op, Single_result res) =>
    match kind_equal op res with
    | None => None
    | Some Eq => Some Eq
    end
  | (Tezos_raw_protocol_alpha.Alpha_context.Cons op ops, Cons_result res ress)
    =>
    match kind_equal op res with
    | None => None
    | Some Eq =>
      match kind_equal_list ops ress with
      | None => None
      | Some Eq => Some Eq
      end
    end
  | _ => None
  end.

Fixpoint pack_contents_list {kind : Type}
  (contents : Tezos_raw_protocol_alpha.Alpha_context.contents_list kind)
  (res : contents_result_list kind) : contents_and_result_list kind :=
  match (contents, res) with
  | (Tezos_raw_protocol_alpha.Alpha_context.Single op, Single_result res) =>
    Single_and_result op res
  | (Tezos_raw_protocol_alpha.Alpha_context.Cons op ops, Cons_result res ress)
    => Cons_and_result op res (pack_contents_list ops ress)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _),
      Cons_result (Manager_operation_result _) (Single_result _)) =>
    (* ❌ Unreachable expressions are not supported *)
    unreachable
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Cons _ _,
      Single_result
        (Manager_operation_result {| operation_result := Failed _ _ |})) =>
    (* ❌ Unreachable expressions are not supported *)
    unreachable
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Cons _ _,
      Single_result
        (Manager_operation_result {| operation_result := Skipped _ |})) =>
    (* ❌ Unreachable expressions are not supported *)
    unreachable
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Cons _ _,
      Single_result
        (Manager_operation_result {| operation_result := Applied _ |})) =>
    (* ❌ Unreachable expressions are not supported *)
    unreachable
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Cons _ _,
      Single_result
        (Manager_operation_result {| operation_result := Backtracked _ _ |})) =>
    (* ❌ Unreachable expressions are not supported *)
    unreachable
  | (Tezos_raw_protocol_alpha.Alpha_context.Single _, Cons_result _ _) =>
    (* ❌ Unreachable expressions are not supported *)
    unreachable
  end.

Fixpoint unpack_contents_list {kind : Type}
  (function_parameter : contents_and_result_list kind)
  : Tezos_raw_protocol_alpha.Alpha_context.contents_list kind *
    contents_result_list kind :=
  match function_parameter with
  | Single_and_result op res =>
    ((Tezos_raw_protocol_alpha.Alpha_context.Single op), (Single_result res))
  | Cons_and_result op res rest =>
    let '(ops, ress) := unpack_contents_list rest in
    ((Tezos_raw_protocol_alpha.Alpha_context.Cons op ops),
      (Cons_result res ress))
  end.

Fixpoint to_list (function_parameter : packed_contents_result_list)
  : list packed_contents_result :=
  match function_parameter with
  | Contents_result_list (Single_result o) => cons (Contents_result o) []
  | Contents_result_list (Cons_result o os) =>
    cons (Contents_result o) (to_list (Contents_result_list os))
  end.

Fixpoint of_list (function_parameter : list packed_contents_result)
  : packed_contents_result_list :=
  match function_parameter with
  | [] =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | cons (Contents_result o) [] => Contents_result_list (Single_result o)
  | cons (Contents_result o) os =>
    let 'Contents_result_list os := of_list os in
    match (o, os) with
    | (Manager_operation_result _, Single_result (Manager_operation_result _))
      => Contents_result_list (Cons_result o os)
    | (Manager_operation_result _, Cons_result _ _) =>
      Contents_result_list (Cons_result o os)
    | _ =>
      Pervasives.failwith
        "Operation result list of length > 1 should only contains manager operations result."
          % string
    end
  end.

Definition operation_data_and_metadata_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (Tezos_raw_protocol_alpha.Alpha_context.packed_protocol_data *
      packed_operation_metadata) :=
  op_atat
    (let arg := def "operation.alpha.operation_with_metadata" % string in
    fun eta => arg None None eta)
    (union None
      (cons
        (case "Operation_with_metadata" % string None
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
          (obj2
            (req None None "contents" % string
              (dynamic_size None contents_and_result_list_encoding))
            (opt None None "signature" % string Signature.encoding))
          (fun function_parameter =>
            match function_parameter with
            |
              (Tezos_raw_protocol_alpha.Alpha_context.Operation_data _,
                No_operation_metadata) => None
            |
              (Tezos_raw_protocol_alpha.Alpha_context.Operation_data op,
                Operation_metadata res) =>
              match kind_equal_list (contents op) (contents res) with
              | None =>
                Pervasives.failwith
                  "cannot decode inconsistent combined operation result" %
                    string
              | Some Eq =>
                Some
                  ((Contents_and_result_list
                    (pack_contents_list (contents op) (contents res))),
                    (signature op))
              end
            end)
          (fun function_parameter =>
            let '(Contents_and_result_list contents, signature) :=
              function_parameter in
            let '(op_contents, res_contents) := unpack_contents_list contents in
            ((Tezos_raw_protocol_alpha.Alpha_context.Operation_data
              {| contents := op_contents; signature := signature |}),
              (Operation_metadata {| contents := res_contents |}))))
        (cons
          (case "Operation_without_metadata" % string None
            (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
            (obj2
              (req None None "contents" % string
                (dynamic_size None Operation.contents_list_encoding))
              (opt None None "signature" % string Signature.encoding))
            (fun function_parameter =>
              match function_parameter with
              |
                (Tezos_raw_protocol_alpha.Alpha_context.Operation_data op,
                  No_operation_metadata) =>
                Some
                  ((Tezos_raw_protocol_alpha.Alpha_context.Contents_list
                    (contents op)), (signature op))
              |
                (Tezos_raw_protocol_alpha.Alpha_context.Operation_data _,
                  Operation_metadata _) => None
              end)
            (fun function_parameter =>
              let
                '(Tezos_raw_protocol_alpha.Alpha_context.Contents_list contents,
                  signature) := function_parameter in
              ((Tezos_raw_protocol_alpha.Alpha_context.Operation_data
                {| contents := contents; signature := signature |}),
                No_operation_metadata))) []))).

Record block_metadata := {
  baker :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
  level : Tezos_raw_protocol_alpha.Alpha_context.Level.t;
  voting_period_kind : Tezos_raw_protocol_alpha.Alpha_context.Voting_period.kind;
  nonce_hash : option Tezos_raw_protocol_alpha.Nonce_hash.t;
  consumed_gas : Tezos_protocol_environment_alpha__Environment.Z.t;
  deactivated :
    list
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
  balance_updates :
    Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates }.

Definition block_metadata_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    block_metadata :=
  op_atat
    (let arg := def "block_header.alpha.metadata" % string in
    fun eta => arg None None eta)
    (conv
      (fun function_parameter =>
        let '{|
          baker := baker;
            level := level;
            voting_period_kind := voting_period_kind;
            nonce_hash := nonce_hash;
            consumed_gas := consumed_gas;
            deactivated := deactivated;
            balance_updates := balance_updates
            |} := function_parameter in
        (baker, level, voting_period_kind, nonce_hash, consumed_gas,
          deactivated, balance_updates))
      (fun function_parameter =>
        let
          '(baker, level, voting_period_kind, nonce_hash, consumed_gas,
            deactivated, balance_updates) := function_parameter in
        {| baker := baker; level := level;
          voting_period_kind := voting_period_kind; nonce_hash := nonce_hash;
          consumed_gas := consumed_gas; deactivated := deactivated;
          balance_updates := balance_updates |}) None
      (obj7 (req None None "baker" % string Signature.Public_key_hash.encoding)
        (req None None "level" % string Level.encoding)
        (req None None "voting_period_kind" % string Voting_period.kind_encoding)
        (req None None "nonce_hash" % string (option Nonce_hash.encoding))
        (req None None "consumed_gas" % string (check_size 10 n))
        (req None None "deactivated" % string
          (list None Signature.Public_key_hash.encoding))
        (req None None "balance_updates" % string
          Delegate.balance_updates_encoding))).
apply_results.mli 7 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Result of applying an operation, can be used for experimenting
    with protocol updates, by clients to print out a summary of the
    operation at pre-injection simulation and at confirmation time,
    and by block explorers. *)

open Alpha_context

(** Result of applying a {!Operation.t}. Follows the same structure. *)
type 'kind operation_metadata = {contents : 'kind contents_result_list}

and packed_operation_metadata =
  | Operation_metadata : 'kind operation_metadata -> packed_operation_metadata
  | No_operation_metadata : packed_operation_metadata

(** Result of applying a {!Operation.contents_list}. Follows the same structure. *)
and 'kind contents_result_list =
  | Single_result : 'kind contents_result -> 'kind contents_result_list
  | Cons_result :
      'kind Kind.manager contents_result
      * 'rest Kind.manager contents_result_list
      -> ('kind * 'rest) Kind.manager contents_result_list

and packed_contents_result_list =
  | Contents_result_list :
      'kind contents_result_list
      -> packed_contents_result_list

(** Result of applying an {!Operation.contents}. Follows the same structure. *)
and 'kind contents_result =
  | Endorsement_result : {
      balance_updates : Delegate.balance_updates;
      delegate : Signature.Public_key_hash.t;
      slots : int list;
    }
      -> Kind.endorsement contents_result
  | Seed_nonce_revelation_result :
      Delegate.balance_updates
      -> Kind.seed_nonce_revelation contents_result
  | Double_endorsement_evidence_result :
      Delegate.balance_updates
      -> Kind.double_endorsement_evidence contents_result
  | Double_baking_evidence_result :
      Delegate.balance_updates
      -> Kind.double_baking_evidence contents_result
  | Activate_account_result :
      Delegate.balance_updates
      -> Kind.activate_account contents_result
  | Proposals_result : Kind.proposals contents_result
  | Ballot_result : Kind.ballot contents_result
  | Manager_operation_result : {
      balance_updates : Delegate.balance_updates;
      operation_result : 'kind manager_operation_result;
      internal_operation_results : packed_internal_operation_result list;
    }
      -> 'kind Kind.manager contents_result

and packed_contents_result =
  | Contents_result : 'kind contents_result -> packed_contents_result

(** The result of an operation in the queue. [Skipped] ones should
    always be at the tail, and after a single [Failed]. *)
and 'kind manager_operation_result =
  | Applied of 'kind successful_manager_operation_result
  | Backtracked of
      'kind successful_manager_operation_result * error list option
  | Failed : 'kind Kind.manager * error list -> 'kind manager_operation_result
  | Skipped : 'kind Kind.manager -> 'kind manager_operation_result

(** Result of applying a {!manager_operation_content}, either internal
    or external. *)
and _ successful_manager_operation_result =
  | Reveal_result : {
      consumed_gas : Z.t;
    }
      -> Kind.reveal successful_manager_operation_result
  | Transaction_result : {
      storage : Script.expr option;
      big_map_diff : Contract.big_map_diff option;
      balance_updates : Delegate.balance_updates;
      originated_contracts : Contract.t list;
      consumed_gas : Z.t;
      storage_size : Z.t;
      paid_storage_size_diff : Z.t;
      allocated_destination_contract : bool;
    }
      -> Kind.transaction successful_manager_operation_result
  | Origination_result : {
      big_map_diff : Contract.big_map_diff option;
      balance_updates : Delegate.balance_updates;
      originated_contracts : Contract.t list;
      consumed_gas : Z.t;
      storage_size : Z.t;
      paid_storage_size_diff : Z.t;
    }
      -> Kind.origination successful_manager_operation_result
  | Delegation_result : {
      consumed_gas : Z.t;
    }
      -> Kind.delegation successful_manager_operation_result

and packed_successful_manager_operation_result =
  | Successful_manager_result :
      'kind successful_manager_operation_result
      -> packed_successful_manager_operation_result

and packed_internal_operation_result =
  | Internal_operation_result :
      'kind internal_operation * 'kind manager_operation_result
      -> packed_internal_operation_result

(** Serializer for {!packed_operation_result}. *)
val operation_metadata_encoding : packed_operation_metadata Data_encoding.t

val operation_data_and_metadata_encoding :
  (Operation.packed_protocol_data * packed_operation_metadata) Data_encoding.t

type 'kind contents_and_result_list =
  | Single_and_result :
      'kind Alpha_context.contents * 'kind contents_result
      -> 'kind contents_and_result_list
  | Cons_and_result :
      'kind Kind.manager Alpha_context.contents
      * 'kind Kind.manager contents_result
      * 'rest Kind.manager contents_and_result_list
      -> ('kind * 'rest) Kind.manager contents_and_result_list

type packed_contents_and_result_list =
  | Contents_and_result_list :
      'kind contents_and_result_list
      -> packed_contents_and_result_list

val contents_and_result_list_encoding :
  packed_contents_and_result_list Data_encoding.t

val pack_contents_list :
  'kind contents_list ->
  'kind contents_result_list ->
  'kind contents_and_result_list

val unpack_contents_list :
  'kind contents_and_result_list ->
  'kind contents_list * 'kind contents_result_list

val to_list : packed_contents_result_list -> packed_contents_result list

val of_list : packed_contents_result list -> packed_contents_result_list

type ('a, 'b) eq = Eq : ('a, 'a) eq

val kind_equal_list :
  'kind contents_list ->
  'kind2 contents_result_list ->
  ('kind, 'kind2) eq option

type block_metadata = {
  baker : Signature.Public_key_hash.t;
  level : Level.t;
  voting_period_kind : Voting_period.kind;
  nonce_hash : Nonce_hash.t option;
  consumed_gas : Z.t;
  deactivated : Signature.Public_key_hash.t list;
  balance_updates : Delegate.balance_updates;
}

val block_metadata_encoding : block_metadata Data_encoding.encoding
apply_results_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Reserved Notation "'operation_metadata".
Reserved Notation "'packed_operation_metadata".
Reserved Notation "'contents_result_list".
Reserved Notation "'packed_contents_result_list".
Reserved Notation "'contents_result".
Reserved Notation "'packed_contents_result".
Reserved Notation "'manager_operation_result".
Reserved Notation "'successful_manager_operation_result".
Reserved Notation "'packed_successful_manager_operation_result".
Reserved Notation "'packed_internal_operation_result".

Record operation_metadata_skeleton {contents : Type} := {
  contents : contents }.
Arguments operation_metadata_skeleton : clear implicits.

Inductive packed_operation_metadata_gadt : Type :=
| Operation_metadata : forall {kind : Type}, 'operation_metadata kind ->
  packed_operation_metadata_gadt
| No_operation_metadata : packed_operation_metadata_gadt

with contents_result_list_gadt : Type :=
| Single_result : forall {kind : Type}, 'contents_result kind ->
  contents_result_list_gadt
| Cons_result : forall {kind : Type},
  'contents_result (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) ->
  contents_result_list_gadt -> contents_result_list_gadt

with packed_contents_result_list_gadt : Type :=
| Contents_result_list : forall {kind : Type}, 'contents_result_list kind ->
  packed_contents_result_list_gadt

with contents_result_gadt : Type :=
| Endorsement_result :
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  list Z -> contents_result_gadt
| Seed_nonce_revelation_result :
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  contents_result_gadt
| Double_endorsement_evidence_result :
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  contents_result_gadt
| Double_baking_evidence_result :
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  contents_result_gadt
| Activate_account_result :
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  contents_result_gadt
| Proposals_result : contents_result_gadt
| Ballot_result : contents_result_gadt
| Manager_operation_result : forall {kind : Type},
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  'manager_operation_result kind -> list 'packed_internal_operation_result ->
  contents_result_gadt

with packed_contents_result_gadt : Type :=
| Contents_result : forall {kind : Type}, 'contents_result kind ->
  packed_contents_result_gadt

with manager_operation_result_gadt : Type :=
| Applied : forall {kind : Type}, 'successful_manager_operation_result kind ->
  manager_operation_result_gadt
| Backtracked : forall {kind : Type}, 'successful_manager_operation_result kind
  ->
  option (list Tezos_protocol_environment_alpha__Environment.Error_monad.error)
  -> manager_operation_result_gadt
| Failed : forall {kind : Type},
  Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind ->
  list Tezos_protocol_environment_alpha__Environment.Error_monad.error ->
  manager_operation_result_gadt
| Skipped : forall {kind : Type},
  Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind ->
  manager_operation_result_gadt

with successful_manager_operation_result_gadt : Type :=
| Reveal_result : Tezos_protocol_environment_alpha__Environment.Z.t ->
  successful_manager_operation_result_gadt
| Transaction_result : option Tezos_raw_protocol_alpha.Alpha_context.Script.expr
  -> option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff ->
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  list Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t -> bool ->
  successful_manager_operation_result_gadt
| Origination_result :
  option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff ->
  Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates ->
  list Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
  successful_manager_operation_result_gadt
| Delegation_result : Tezos_protocol_environment_alpha__Environment.Z.t ->
  successful_manager_operation_result_gadt

with packed_successful_manager_operation_result_gadt : Type :=
| Successful_manager_result : forall {kind : Type},
  'successful_manager_operation_result kind ->
  packed_successful_manager_operation_result_gadt

with packed_internal_operation_result_gadt : Type :=
| Internal_operation_result : forall {kind : Type},
  Tezos_raw_protocol_alpha.Alpha_context.internal_operation kind ->
  'manager_operation_result kind -> packed_internal_operation_result_gadt

where "'operation_metadata" := (fun (kind : Type) =>
  operation_metadata_skeleton ('contents_result_list kind))
and "'packed_operation_metadata" := (packed_operation_metadata_gadt)
and "'contents_result_list" := (fun (kind : Type) => contents_result_list_gadt)
and "'packed_contents_result_list" := (packed_contents_result_list_gadt)
and "'contents_result" := (fun (kind : Type) => contents_result_gadt)
and "'packed_contents_result" := (packed_contents_result_gadt)
and "'manager_operation_result" := (fun (kind : Type) =>
  manager_operation_result_gadt)
and "'successful_manager_operation_result" := (fun (_ : Type) =>
  successful_manager_operation_result_gadt)
and "'packed_successful_manager_operation_result" :=
  (packed_successful_manager_operation_result_gadt)
and "'packed_internal_operation_result" :=
  (packed_internal_operation_result_gadt).

Definition operation_metadata := 'operation_metadata.
Definition packed_operation_metadata := 'packed_operation_metadata.
Definition contents_result_list := 'contents_result_list.
Definition packed_contents_result_list := 'packed_contents_result_list.
Definition contents_result := 'contents_result.
Definition packed_contents_result := 'packed_contents_result.
Definition manager_operation_result := 'manager_operation_result.
Definition successful_manager_operation_result :=
  'successful_manager_operation_result.
Definition packed_successful_manager_operation_result :=
  'packed_successful_manager_operation_result.
Definition packed_internal_operation_result :=
  'packed_internal_operation_result.

Parameter operation_metadata_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
  packed_operation_metadata.

Parameter operation_data_and_metadata_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
  (Tezos_raw_protocol_alpha.Alpha_context.Operation.packed_protocol_data *
    packed_operation_metadata).

Reserved Notation "'contents_and_result_list".

Inductive contents_and_result_list_gadt : Type :=
| Single_and_result : forall {kind : Type},
  Tezos_raw_protocol_alpha.Alpha_context.contents kind -> contents_result kind
  -> contents_and_result_list_gadt
| Cons_and_result : forall {kind : Type},
  Tezos_raw_protocol_alpha.Alpha_context.contents
    (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) ->
  contents_result (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind) ->
  contents_and_result_list_gadt -> contents_and_result_list_gadt

where "'contents_and_result_list" := (fun (kind : Type) =>
  contents_and_result_list_gadt).

Definition contents_and_result_list := 'contents_and_result_list.

Reserved Notation "'packed_contents_and_result_list".

Inductive packed_contents_and_result_list_gadt : Type :=
| Contents_and_result_list : forall {kind : Type}, contents_and_result_list kind
  -> packed_contents_and_result_list_gadt

where "'packed_contents_and_result_list" :=
  (packed_contents_and_result_list_gadt).

Definition packed_contents_and_result_list := 'packed_contents_and_result_list.

Parameter contents_and_result_list_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
  packed_contents_and_result_list.

Parameter pack_contents_list : forall {kind : Type},
Tezos_raw_protocol_alpha.Alpha_context.contents_list kind ->
  contents_result_list kind -> contents_and_result_list kind.

Parameter unpack_contents_list : forall {kind : Type},
contents_and_result_list kind ->
  Tezos_raw_protocol_alpha.Alpha_context.contents_list kind *
    contents_result_list kind.

Parameter to_list : packed_contents_result_list -> list packed_contents_result.

Parameter of_list : list packed_contents_result -> packed_contents_result_list.

Reserved Notation "'eq".

Inductive eq_gadt : Type :=
| Eq : eq_gadt

where "'eq" := (fun (a b : Type) => eq_gadt).

Definition eq := 'eq.

Parameter kind_equal_list : forall {kind kind2 : Type},
Tezos_raw_protocol_alpha.Alpha_context.contents_list kind ->
  contents_result_list kind2 -> option (eq kind kind2).

Record block_metadata := {
  baker :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
  level : Tezos_raw_protocol_alpha.Alpha_context.Level.t;
  voting_period_kind : Tezos_raw_protocol_alpha.Alpha_context.Voting_period.kind;
  nonce_hash : option Tezos_raw_protocol_alpha.Nonce_hash.t;
  consumed_gas : Tezos_protocol_environment_alpha__Environment.Z.t;
  deactivated :
    list
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
  balance_updates :
    Tezos_raw_protocol_alpha.Alpha_context.Delegate.balance_updates }.

Parameter block_metadata_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
  block_metadata.
baking.ml 59 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Misc

type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)

type error += Timestamp_too_early of Timestamp.t * Timestamp.t

(* `Permanent *)

type error += Unexpected_endorsement (* `Permanent *)

type error +=
  | Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t

(* `Permanent *)

type error += Invalid_signature (* `Permanent *)

type error += Invalid_stamp (* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"baking.timestamp_too_early"
    ~title:"Block forged too early"
    ~description:
      "The block timestamp is before the first slot for this baker at this \
       level"
    ~pp:(fun ppf (r, p) ->
      Format.fprintf
        ppf
        "Block forged too early (%a is before %a)"
        Time.pp_hum
        p
        Time.pp_hum
        r)
    Data_encoding.(
      obj2 (req "minimum" Time.encoding) (req "provided" Time.encoding))
    (function Timestamp_too_early (r, p) -> Some (r, p) | _ -> None)
    (fun (r, p) -> Timestamp_too_early (r, p)) ;
  register_error_kind
    `Permanent
    ~id:"baking.invalid_fitness_gap"
    ~title:"Invalid fitness gap"
    ~description:"The gap of fitness is out of bounds"
    ~pp:(fun ppf (m, g) ->
      Format.fprintf ppf "The gap of fitness %Ld is not between 0 and %Ld" g m)
    Data_encoding.(obj2 (req "maximum" int64) (req "provided" int64))
    (function Invalid_fitness_gap (m, g) -> Some (m, g) | _ -> None)
    (fun (m, g) -> Invalid_fitness_gap (m, g)) ;
  register_error_kind
    `Permanent
    ~id:"baking.invalid_block_signature"
    ~title:"Invalid block signature"
    ~description:"A block was not signed with the expected private key."
    ~pp:(fun ppf (block, pkh) ->
      Format.fprintf
        ppf
        "Invalid signature for block %a. Expected: %a."
        Block_hash.pp_short
        block
        Signature.Public_key_hash.pp_short
        pkh)
    Data_encoding.(
      obj2
        (req "block" Block_hash.encoding)
        (req "expected" Signature.Public_key_hash.encoding))
    (function
      | Invalid_block_signature (block, pkh) -> Some (block, pkh) | _ -> None)
    (fun (block, pkh) -> Invalid_block_signature (block, pkh)) ;
  register_error_kind
    `Permanent
    ~id:"baking.invalid_signature"
    ~title:"Invalid block signature"
    ~description:"The block's signature is invalid"
    ~pp:(fun ppf () -> Format.fprintf ppf "Invalid block signature")
    Data_encoding.empty
    (function Invalid_signature -> Some () | _ -> None)
    (fun () -> Invalid_signature) ;
  register_error_kind
    `Permanent
    ~id:"baking.insufficient_proof_of_work"
    ~title:"Insufficient block proof-of-work stamp"
    ~description:"The block's proof-of-work stamp is insufficient"
    ~pp:(fun ppf () -> Format.fprintf ppf "Insufficient proof-of-work stamp")
    Data_encoding.empty
    (function Invalid_stamp -> Some () | _ -> None)
    (fun () -> Invalid_stamp) ;
  register_error_kind
    `Permanent
    ~id:"baking.unexpected_endorsement"
    ~title:"Endorsement from unexpected delegate"
    ~description:
      "The operation is signed by a delegate without endorsement rights."
    ~pp:(fun ppf () ->
      Format.fprintf
        ppf
        "The endorsement is signed by a delegate without endorsement rights.")
    Data_encoding.unit
    (function Unexpected_endorsement -> Some () | _ -> None)
    (fun () -> Unexpected_endorsement)

let minimal_time c priority pred_timestamp =
  let priority = Int32.of_int priority in
  let rec cumsum_time_between_blocks acc durations p =
    if Compare.Int32.( <= ) p 0l then ok acc
    else
      match durations with
      | [] ->
          cumsum_time_between_blocks acc [Period.one_minute] p
      | [last] ->
          Period.mult p last >>? fun period -> Timestamp.(acc +? period)
      | first :: durations ->
          Timestamp.(acc +? first)
          >>? fun acc ->
          let p = Int32.pred p in
          cumsum_time_between_blocks acc durations p
  in
  Lwt.return
    (cumsum_time_between_blocks
       pred_timestamp
       (Constants.time_between_blocks c)
       (Int32.succ priority))

let earlier_predecessor_timestamp ctxt level =
  let current = Level.current ctxt in
  let current_timestamp = Timestamp.current ctxt in
  let gap = Level.diff level current in
  let step = List.hd (Constants.time_between_blocks ctxt) in
  if Compare.Int32.(gap < 1l) then
    failwith "Baking.earlier_block_timestamp: past block."
  else
    Lwt.return (Period.mult (Int32.pred gap) step)
    >>=? fun delay ->
    Lwt.return Timestamp.(current_timestamp +? delay)
    >>=? fun result -> return result

let check_timestamp c priority pred_timestamp =
  minimal_time c priority pred_timestamp
  >>=? fun minimal_time ->
  let timestamp = Alpha_context.Timestamp.current c in
  Lwt.return
    (record_trace
       (Timestamp_too_early (minimal_time, timestamp))
       Timestamp.(timestamp -? minimal_time))

let check_baking_rights c {Block_header.priority; _} pred_timestamp =
  let level = Level.current c in
  Roll.baking_rights_owner c level ~priority
  >>=? fun delegate ->
  check_timestamp c priority pred_timestamp
  >>=? fun block_delay -> return (delegate, block_delay)

type error += Incorrect_priority (* `Permanent *)

type error += Incorrect_number_of_endorsements (* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"incorrect_priority"
    ~title:"Incorrect priority"
    ~description:"Block priority must be non-negative."
    ~pp:(fun ppf () ->
      Format.fprintf ppf "The block priority must be non-negative.")
    Data_encoding.unit
    (function Incorrect_priority -> Some () | _ -> None)
    (fun () -> Incorrect_priority)

let () =
  let description =
    "The number of endorsements must be non-negative and at most the \
     endosers_per_block constant."
  in
  register_error_kind
    `Permanent
    ~id:"incorrect_number_of_endorsements"
    ~title:"Incorrect number of endorsements"
    ~description
    ~pp:(fun ppf () -> Format.fprintf ppf "%s" description)
    Data_encoding.unit
    (function Incorrect_number_of_endorsements -> Some () | _ -> None)
    (fun () -> Incorrect_number_of_endorsements)

let baking_reward ctxt ~block_priority:prio ~included_endorsements:num_endo =
  fail_unless Compare.Int.(prio >= 0) Incorrect_priority
  >>=? fun () ->
  let max_endorsements = Constants.endorsers_per_block ctxt in
  fail_unless
    Compare.Int.(num_endo >= 0 && num_endo <= max_endorsements)
    Incorrect_number_of_endorsements
  >>=? fun () ->
  let prio_factor_denominator = Int64.(succ (of_int prio)) in
  let endo_factor_numerator =
    Int64.of_int (8 + (2 * num_endo / max_endorsements))
  in
  let endo_factor_denominator = 10L in
  Lwt.return
    Tez.(
      Constants.block_reward ctxt *? endo_factor_numerator
      >>? fun val1 ->
      val1 /? endo_factor_denominator
      >>? fun val2 -> val2 /? prio_factor_denominator)

let endorsing_reward ctxt ~block_priority:prio n =
  if Compare.Int.(prio >= 0) then
    Lwt.return
      Tez.(Constants.endorsement_reward ctxt /? Int64.(succ (of_int prio)))
    >>=? fun tez -> Lwt.return Tez.(tez *? Int64.of_int n)
  else fail Incorrect_priority

let baking_priorities c level =
  let rec f priority =
    Roll.baking_rights_owner c level ~priority
    >>=? fun delegate -> return (LCons (delegate, fun () -> f (succ priority)))
  in
  f 0

let endorsement_rights c level =
  fold_left_s
    (fun acc slot ->
      Roll.endorsement_rights_owner c level ~slot
      >>=? fun pk ->
      let pkh = Signature.Public_key.hash pk in
      let right =
        match Signature.Public_key_hash.Map.find_opt pkh acc with
        | None ->
            (pk, [slot], false)
        | Some (pk, slots, used) ->
            (pk, slot :: slots, used)
      in
      return (Signature.Public_key_hash.Map.add pkh right acc))
    Signature.Public_key_hash.Map.empty
    (0 --> (Constants.endorsers_per_block c - 1))

let check_endorsement_rights ctxt chain_id (op : Kind.endorsement Operation.t)
    =
  let current_level = Level.current ctxt in
  let (Single (Endorsement {level; _})) = op.protocol_data.contents in
  ( if Raw_level.(succ level = current_level.level) then
    return (Alpha_context.allowed_endorsements ctxt)
  else endorsement_rights ctxt (Level.from_raw ctxt level) )
  >>=? fun endorsements ->
  match
    Signature.Public_key_hash.Map.fold (* no find_first *)
      (fun pkh (pk, slots, used) acc ->
        match Operation.check_signature_sync pk chain_id op with
        | Error _ ->
            acc
        | Ok () ->
            Some (pkh, slots, used))
      endorsements
      None
  with
  | None ->
      fail Unexpected_endorsement
  | Some v ->
      return v

let select_delegate delegate delegate_list max_priority =
  let rec loop acc l n =
    if Compare.Int.(n >= max_priority) then return (List.rev acc)
    else
      let (LCons (pk, t)) = l in
      let acc =
        if
          Signature.Public_key_hash.equal
            delegate
            (Signature.Public_key.hash pk)
        then n :: acc
        else acc
      in
      t () >>=? fun t -> loop acc t (succ n)
  in
  loop [] delegate_list 0

let first_baking_priorities ctxt ?(max_priority = 32) delegate level =
  baking_priorities ctxt level
  >>=? fun delegate_list -> select_delegate delegate delegate_list max_priority

let check_hash hash stamp_threshold =
  let bytes = Block_hash.to_bytes hash in
  let word = MBytes.get_int64 bytes 0 in
  Compare.Uint64.(word <= stamp_threshold)

let check_header_proof_of_work_stamp shell contents stamp_threshold =
  let hash =
    Block_header.hash
      {shell; protocol_data = {contents; signature = Signature.zero}}
  in
  check_hash hash stamp_threshold

let check_proof_of_work_stamp ctxt block =
  let proof_of_work_threshold = Constants.proof_of_work_threshold ctxt in
  if
    check_header_proof_of_work_stamp
      block.Block_header.shell
      block.protocol_data.contents
      proof_of_work_threshold
  then return_unit
  else fail Invalid_stamp

let check_signature block chain_id key =
  let check_signature key
      {Block_header.shell; protocol_data = {contents; signature}} =
    let unsigned_header =
      Data_encoding.Binary.to_bytes_exn
        Block_header.unsigned_encoding
        (shell, contents)
    in
    Signature.check
      ~watermark:(Block_header chain_id)
      key
      signature
      unsigned_header
  in
  if check_signature key block then return_unit
  else
    fail
      (Invalid_block_signature
         (Block_header.hash block, Signature.Public_key.hash key))

let max_fitness_gap _ctxt = 1L

let check_fitness_gap ctxt (block : Block_header.t) =
  let current_fitness = Fitness.current ctxt in
  Lwt.return (Fitness.to_int64 block.shell.fitness)
  >>=? fun announced_fitness ->
  let gap = Int64.sub announced_fitness current_fitness in
  if Compare.Int64.(gap <= 0L || max_fitness_gap ctxt < gap) then
    fail (Invalid_fitness_gap (max_fitness_gap ctxt, gap))
  else return_unit

let last_of_a_cycle ctxt l =
  Compare.Int32.(
    Int32.succ l.Level.cycle_position = Constants.blocks_per_cycle ctxt)

let dawn_of_a_new_cycle ctxt =
  let level = Level.current ctxt in
  if last_of_a_cycle ctxt level then return_some level.cycle else return_none

let minimum_allowed_endorsements ctxt ~block_delay =
  let minimum = Constants.initial_endorsers ctxt in
  let delay_per_missing_endorsement =
    Int64.to_int
      (Period.to_seconds (Constants.delay_per_missing_endorsement ctxt))
  in
  let reduced_time_constraint =
    let delay = Int64.to_int (Period.to_seconds block_delay) in
    if Compare.Int.(delay_per_missing_endorsement = 0) then delay
    else delay / delay_per_missing_endorsement
  in
  Compare.Int.max 0 (minimum - reduced_time_constraint)

let minimal_valid_time ctxt ~priority ~endorsing_power =
  let predecessor_timestamp = Timestamp.current ctxt in
  minimal_time ctxt priority predecessor_timestamp
  >>=? fun minimal_time ->
  let minimal_required_endorsements = Constants.initial_endorsers ctxt in
  let delay_per_missing_endorsement =
    Constants.delay_per_missing_endorsement ctxt
  in
  let missing_endorsements =
    Compare.Int.max 0 (minimal_required_endorsements - endorsing_power)
  in
  match
    Period.mult
      (Int32.of_int missing_endorsements)
      delay_per_missing_endorsement
  with
  | Ok delay ->
      return (Time.add minimal_time (Period.to_seconds delay))
  | Error _ as err ->
      Lwt.return err
baking_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Import Misc.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "baking.timestamp_too_early" % string
      "Block forged too early" % string
      "The block timestamp is before the first slot for this baker at this level"
        % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(r, p) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Block forged too early (" % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " is before " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          ")" % char
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "Block forged too early (%a is before %a)" % string) Time.pp_hum
              p Time.pp_hum r))
      (obj2 (req None None "minimum" % string Time.encoding)
        (req None None "provided" % string Time.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Timestamp_too_early
            r p => Some (r, p)
        | _ => None
        end)
      (fun function_parameter =>
        let '(r, p) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Timestamp_too_early
          r p) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "baking.invalid_fitness_gap" % string
      "Invalid fitness gap" % string
      "The gap of fitness is out of bounds" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(m, g) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "The gap of fitness " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int64
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " is not between 0 and " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int64
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))))
                "The gap of fitness %Ld is not between 0 and %Ld" % string) g m))
      (obj2 (req None None "maximum" % string int64)
        (req None None "provided" % string int64))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_fitness_gap
            m g => Some (m, g)
        | _ => None
        end)
      (fun function_parameter =>
        let '(m, g) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_fitness_gap
          m g) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "baking.invalid_block_signature" % string
      "Invalid block signature" % string
      "A block was not signed with the expected private key." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(block, pkh) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Invalid signature for block " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      ". Expected: " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          "." % char
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "Invalid signature for block %a. Expected: %a." % string)
              Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.pp_short)
              block Signature.Public_key_hash.pp_short pkh))
      (obj2
        (req None None "block" % string
          Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.encoding))
        (req None None "expected" % string Signature.Public_key_hash.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_block_signature
            block pkh => Some (block, pkh)
        | _ => None
        end)
      (fun function_parameter =>
        let '(block, pkh) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_block_signature
          block pkh) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "baking.invalid_signature" % string
      "Invalid block signature" % string
      "The block's signature is invalid" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Invalid block signature" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Invalid block signature" % string))) Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_signature
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_signature)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "baking.insufficient_proof_of_work" % string
      "Insufficient block proof-of-work stamp" % string
      "The block's proof-of-work stamp is insufficient" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Insufficient proof-of-work stamp" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Insufficient proof-of-work stamp" % string)))
      Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_stamp
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_stamp)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "baking.unexpected_endorsement" % string
    "Endorsement from unexpected delegate" % string
    "The operation is signed by a delegate without endorsement rights." % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "The endorsement is signed by a delegate without endorsement rights."
                  % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "The endorsement is signed by a delegate without endorsement rights."
                % string))) Data_encoding.unit
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_endorsement
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_endorsement).

Definition minimal_time
  (c : Tezos_raw_protocol_alpha__Alpha_context.context) (priority : Z)
  (pred_timestamp : Tezos_raw_protocol_alpha.Alpha_context.Timestamp.time)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Timestamp.time) :=
  let priority := Int32.of_int priority in
  let fix cumsum_time_between_blocks
    (acc : Tezos_raw_protocol_alpha.Alpha_context.Timestamp.time) (durations :
    list Tezos_raw_protocol_alpha.Alpha_context.Period.period) (p :
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
    : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Timestamp.time :=
    if
      Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lteq)
        p
        (* ❌ Constant of type int32 is converted to int *)
        0 then
      ok acc
    else
      match durations with
      | [] => cumsum_time_between_blocks acc (cons Period.one_minute []) p
      | cons last [] =>
        op_gtgtquestion (Period.mult p last)
          (fun period => op_plusquestion acc period)
      | cons first durations =>
        op_gtgtquestion (op_plusquestion acc first)
          (fun acc =>
            let p := Int32.pred p in
            cumsum_time_between_blocks acc durations p)
      end in
  Lwt.__return
    (cumsum_time_between_blocks pred_timestamp (Constants.time_between_blocks c)
      (Int32.succ priority)).

Definition earlier_predecessor_timestamp
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (level : Tezos_raw_protocol_alpha.Alpha_context.Level.level)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Timestamp.time) :=
  let current := Level.current ctxt in
  let current_timestamp := Timestamp.current ctxt in
  let gap := Level.diff level current in
  let step := List.hd (Constants.time_between_blocks ctxt) in
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
      gap
      (* ❌ Constant of type int32 is converted to int *)
      1 then
    failwith "Baking.earlier_block_timestamp: past block." % string
  else
    op_gtgteqquestion (Lwt.__return (Period.mult (Int32.pred gap) step))
      (fun delay =>
        op_gtgteqquestion
          (Lwt.__return (op_plusquestion current_timestamp delay))
          (fun result => __return result)).

Definition check_timestamp
  (c : Tezos_raw_protocol_alpha__Alpha_context.context) (priority : Z)
  (pred_timestamp : Tezos_raw_protocol_alpha.Alpha_context.Timestamp.time)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha__Alpha_context.Period.t) :=
  op_gtgteqquestion (minimal_time c priority pred_timestamp)
    (fun minimal_time =>
      let timestamp := Alpha_context.Timestamp.current c in
      Lwt.__return
        (record_trace
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Timestamp_too_early
            minimal_time timestamp) (op_minusquestion timestamp minimal_time))).

Definition check_baking_rights
  (c : Tezos_raw_protocol_alpha__Alpha_context.context)
  (function_parameter :
    Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents)
  : Tezos_raw_protocol_alpha.Alpha_context.Timestamp.time ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha__Alpha_context.public_key *
          Tezos_raw_protocol_alpha__Alpha_context.Period.t)) :=
  let '{| Block_header.priority := priority |} := function_parameter in
  fun pred_timestamp =>
    let level := Level.current c in
    op_gtgteqquestion (Roll.baking_rights_owner c level priority)
      (fun delegate =>
        op_gtgteqquestion (check_timestamp c priority pred_timestamp)
          (fun block_delay => __return (delegate, block_delay))).

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "incorrect_priority" % string "Incorrect priority" % string
    "Block priority must be non-negative." % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "The block priority must be non-negative." % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "The block priority must be non-negative." % string)))
    Data_encoding.unit
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Incorrect_priority
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Incorrect_priority).

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  let description :=
    "The number of endorsements must be non-negative and at most the endosers_per_block constant."
      % string in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "incorrect_number_of_endorsements" % string
    "Incorrect number of endorsements" % string description
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "%s" % string) description)) Data_encoding.unit
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Incorrect_number_of_endorsements
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Incorrect_number_of_endorsements).

Definition baking_reward
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (prio :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  (num_endo :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Tez.tez) :=
  op_gtgteqquestion
    (fail_unless
      (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
        prio 0)
      Tezos_protocol_environment_alpha__Environment.Error_monad.Incorrect_priority)
    (fun function_parameter =>
      let 'tt := function_parameter in
      let max_endorsements := Constants.endorsers_per_block ctxt in
      op_gtgteqquestion
        (fail_unless
          (op_andand
            (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
              num_endo 0)
            (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lteq)
              num_endo max_endorsements))
          Tezos_protocol_environment_alpha__Environment.Error_monad.Incorrect_number_of_endorsements)
        (fun function_parameter =>
          let 'tt := function_parameter in
          let prio_factor_denominator := succ (of_int prio) in
          let endo_factor_numerator :=
            Int64.of_int
              (op_plus 8 (op_div (op_star 2 num_endo) max_endorsements)) in
          let endo_factor_denominator :=
            (* ❌ Constant of type int64 is converted to int *)
            10 in
          Lwt.__return
            (op_gtgtquestion
              (op_starquestion (Constants.block_reward ctxt)
                endo_factor_numerator)
              (fun val1 =>
                op_gtgtquestion (op_divquestion val1 endo_factor_denominator)
                  (fun val2 => op_divquestion val2 prio_factor_denominator))))).

Definition endorsing_reward
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (prio :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  (n : Z)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Tez.tez) :=
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
      prio 0 then
    op_gtgteqquestion
      (Lwt.__return
        (op_divquestion (Constants.endorsement_reward ctxt) (succ (of_int prio))))
      (fun tez => Lwt.__return (op_starquestion tez (Int64.of_int n)))
  else
    fail
      Tezos_protocol_environment_alpha__Environment.Error_monad.Incorrect_priority.

Definition baking_priorities
  (c : Tezos_raw_protocol_alpha__Alpha_context.context)
  (level : Tezos_raw_protocol_alpha__Alpha_context.Level.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Misc.lazy_list_t
        Tezos_raw_protocol_alpha__Alpha_context.public_key)) :=
  let fix f (priority : Z)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Misc.lazy_list_t
          Tezos_raw_protocol_alpha__Alpha_context.public_key)) :=
    op_gtgteqquestion (Roll.baking_rights_owner c level priority)
      (fun delegate =>
        __return
          (Tezos_raw_protocol_alpha.Misc.LCons delegate
            (fun function_parameter =>
              let 'tt := function_parameter in
              f (succ priority)))) in
  f 0.

Definition endorsement_rights
  (c : Tezos_raw_protocol_alpha__Alpha_context.context)
  (level : Tezos_raw_protocol_alpha__Alpha_context.Level.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
        (Tezos_raw_protocol_alpha__Alpha_context.public_key * list Z * bool))) :=
  fold_left_s
    (fun acc =>
      fun slot =>
        op_gtgteqquestion (Roll.endorsement_rights_owner c level slot)
          (fun pk =>
            let pkh := Signature.Public_key.hash pk in
            let right :=
              match Signature.Public_key_hash.Map.find_opt pkh acc with
              | None => (pk, (cons slot []), false)
              | Some (pk, slots, used) => (pk, (cons slot slots), used)
              end in
            __return (Signature.Public_key_hash.Map.add pkh right acc)))
    Signature.Public_key_hash.Map.empty
    (op_minusminusgt 0 (op_minus (Constants.endorsers_per_block c) 1)).

Definition check_endorsement_rights
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (chain_id :
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (op :
    Tezos_raw_protocol_alpha.Alpha_context.Operation.t
      Tezos_raw_protocol_alpha.Alpha_context.Kind.endorsement)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.key
        * list Z * bool)) :=
  let current_level := Level.current ctxt in
  let
    'Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Endorsement {| level := level |}) :=
    contents (protocol_data op) in
  op_gtgteqquestion
    (if op_eq (succ level) (level current_level) then
      __return (Alpha_context.allowed_endorsements ctxt)
    else
      endorsement_rights ctxt (Level.from_raw ctxt None level))
    (fun endorsements =>
      match
        Signature.Public_key_hash.Map.fold
          (fun pkh =>
            fun function_parameter =>
              let '(pk, slots, used) := function_parameter in
              fun acc =>
                match Operation.check_signature_sync pk chain_id op with
                |
                  Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                    _ => acc
                | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok tt
                  => Some (pkh, slots, used)
                end) endorsements None with
      | None =>
        fail
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_endorsement
      | Some v => __return v
      end).

Definition select_delegate
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (delegate_list :
    Tezos_raw_protocol_alpha.Misc.lazy_list_t
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
  (max_priority :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list
        Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))) :=
  let fix loop
    (acc :
    list
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
    (l :
    Tezos_raw_protocol_alpha.Misc.lazy_list_t
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t) (n :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (list
          Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))) :=
    if
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
        n max_priority then
      __return (List.rev acc)
    else
      let 'Tezos_raw_protocol_alpha.Misc.LCons pk t := l in
      let acc :=
        if
          Signature.Public_key_hash.equal delegate
            (Signature.Public_key.hash pk) then
          cons n acc
        else
          acc in
      op_gtgteqquestion (t tt) (fun t => loop acc t (succ n)) in
  loop [] delegate_list 0.

Definition first_baking_priorities
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (op_staroptstar :
    option
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_raw_protocol_alpha__Alpha_context.Level.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (list
            Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))) :=
  let max_priority :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => 32
    end in
  fun delegate =>
    fun level =>
      op_gtgteqquestion (baking_priorities ctxt level)
        (fun delegate_list =>
          select_delegate delegate delegate_list max_priority).

Definition check_hash
  (hash :
    Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (stamp_threshold :
    Tezos_protocol_environment_alpha__Environment.Compare.Uint64.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : bool :=
  let bytes :=
    Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.to_bytes)
      hash in
  let word := MBytes.get_int64 string 0 in
  Tezos_protocol_environment_alpha__Environment.Compare.Uint64.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lteq)
    word stamp_threshold.

Definition check_header_proof_of_work_stamp
  (shell :
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header)
  (contents : Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents)
  (stamp_threshold :
    Tezos_protocol_environment_alpha__Environment.Compare.Uint64.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : bool :=
  let hash :=
    Block_header.hash
      {| shell := shell;
        protocol_data := {| contents := contents; signature := Signature.zero |}
        |} in
  check_hash hash stamp_threshold.

Definition check_proof_of_work_stamp
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (block : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let proof_of_work_threshold := Constants.proof_of_work_threshold ctxt in
  if
    check_header_proof_of_work_stamp (Block_header.shell block)
      (contents (protocol_data block)) proof_of_work_threshold then
    return_unit
  else
    fail Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_stamp.

Definition check_signature
  (block : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
  (chain_id :
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (key : Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let check_signature
    (key : Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
    (function_parameter : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
    : bool :=
    let '{|
      Block_header.shell := shell;
        Block_header.protocol_data := {|
          contents := contents; signature := signature |}
        |} := function_parameter in
    let unsigned_header :=
      Data_encoding.Binary.to_bytes_exn Block_header.unsigned_encoding
        (shell, contents) in
    Signature.check
      (Some
        (Tezos_protocol_environment_alpha__Environment.Signature.Block_header
          chain_id)) key signature unsigned_header in
  if check_signature key block then
    return_unit
  else
    fail
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_block_signature
        (Block_header.hash block) (Signature.Public_key.hash key)).

Definition max_fitness_gap {A : Type} (_ctxt : A) : int64 :=
  (* ❌ Constant of type int64 is converted to int *)
  1.

Definition check_fitness_gap
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (block : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let current_fitness := Fitness.current ctxt in
  op_gtgteqquestion (Lwt.__return (Fitness.to_int64 (fitness (shell block))))
    (fun announced_fitness =>
      let gap := Int64.sub announced_fitness current_fitness in
      if
        op_pipepipe
          (Tezos_protocol_environment_alpha__Environment.Compare.Int64.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lteq)
            gap
            (* ❌ Constant of type int64 is converted to int *)
            0)
          (Tezos_protocol_environment_alpha__Environment.Compare.Int64.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
            (max_fitness_gap ctxt) gap) then
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_fitness_gap
            (max_fitness_gap ctxt) gap)
      else
        return_unit).

Definition last_of_a_cycle
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (l : Tezos_raw_protocol_alpha.Alpha_context.Level.t) : bool :=
  Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
    (Int32.succ (Level.cycle_position l)) (Constants.blocks_per_cycle ctxt).

Definition dawn_of_a_new_cycle
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha__Alpha_context.Cycle.t)) :=
  let level := Level.current ctxt in
  if last_of_a_cycle ctxt level then
    return_some (cycle level)
  else
    return_none.

Definition minimum_allowed_endorsements
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (block_delay : Tezos_raw_protocol_alpha.Alpha_context.Period.period)
  : Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t) :=
  let minimum := Constants.initial_endorsers ctxt in
  let delay_per_missing_endorsement :=
    Int64.to_int
      (Period.to_seconds (Constants.delay_per_missing_endorsement ctxt)) in
  let reduced_time_constraint :=
    let delay := Int64.to_int (Period.to_seconds block_delay) in
    if
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
        delay_per_missing_endorsement 0 then
      delay
    else
      op_div delay delay_per_missing_endorsement in
  Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.max)
    0 (op_minus minimum reduced_time_constraint).

Definition minimal_valid_time
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context) (priority : Z)
  (endorsing_power : Z)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Time.t) :=
  let predecessor_timestamp := Timestamp.current ctxt in
  op_gtgteqquestion (minimal_time ctxt priority predecessor_timestamp)
    (fun minimal_time =>
      let minimal_required_endorsements := Constants.initial_endorsers ctxt in
      let delay_per_missing_endorsement :=
        Constants.delay_per_missing_endorsement ctxt in
      let missing_endorsements :=
        Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.max)
          0 (op_minus minimal_required_endorsements endorsing_power) in
      match
        Period.mult (Int32.of_int missing_endorsements)
          delay_per_missing_endorsement with
      | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok delay =>
        __return (Time.add minimal_time (Period.to_seconds delay))
      |
        (Tezos_protocol_environment_alpha__Environment.Pervasives.Error _) as
          err => Lwt.__return err
      end).
baking.mli 9 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Misc

type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)

type error += Timestamp_too_early of Timestamp.t * Timestamp.t

(* `Permanent *)

type error +=
  | Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t

(* `Permanent *)

type error += Unexpected_endorsement

type error += Invalid_signature (* `Permanent *)

type error += Invalid_stamp (* `Permanent *)

(** [minimal_time ctxt priority pred_block_time] returns the minimal
    time, given the predecessor block timestamp [pred_block_time],
    after which a baker with priority [priority] is allowed to
    bake. Fail with [Invalid_time_between_blocks_constant] if the minimal
    time cannot be computed. *)
val minimal_time : context -> int -> Time.t -> Time.t tzresult Lwt.t

(** [check_baking_rights ctxt block pred_timestamp] verifies that:
    * the contract that owned the roll at cycle start has the block signer as delegate.
    * the timestamp is coherent with the announced slot.
*)
val check_baking_rights :
  context ->
  Block_header.contents ->
  Time.t ->
  (public_key * Period.t) tzresult Lwt.t

(** For a given level computes who has the right to
    include an endorsement in the next block.
    The result can be stored in Alpha_context.allowed_endorsements *)
val endorsement_rights :
  context ->
  Level.t ->
  (public_key * int list * bool) Signature.Public_key_hash.Map.t tzresult Lwt.t

(** Check that the operation was signed by a delegate allowed
    to endorse at the level specified by the endorsement. *)
val check_endorsement_rights :
  context ->
  Chain_id.t ->
  Kind.endorsement Operation.t ->
  (public_key_hash * int list * bool) tzresult Lwt.t

(** Returns the baking reward calculated w.r.t a given priority [p] and a
    number [e] of included endorsements as follows:
      (block_reward / (p+1)) * (0.8 + 0.2 * e / endorsers_per_block)
*)
val baking_reward :
  context ->
  block_priority:int ->
  included_endorsements:int ->
  Tez.t tzresult Lwt.t

(** Returns the endorsing reward calculated w.r.t a given priority.  *)
val endorsing_reward :
  context -> block_priority:int -> int -> Tez.t tzresult Lwt.t

(** [baking_priorities ctxt level] is the lazy list of contract's
    public key hashes that are allowed to bake for [level]. *)
val baking_priorities : context -> Level.t -> public_key lazy_list

(** [first_baking_priorities ctxt ?max_priority contract_hash level]
    is a list of priorities of max [?max_priority] elements, where the
    delegate of [contract_hash] is allowed to bake for [level]. If
    [?max_priority] is [None], a sensible number of priorities is
    returned. *)
val first_baking_priorities :
  context ->
  ?max_priority:int ->
  public_key_hash ->
  Level.t ->
  int list tzresult Lwt.t

(** [check_signature ctxt chain_id block id] check if the block is
    signed with the given key, and belongs to the given [chain_id] *)
val check_signature :
  Block_header.t -> Chain_id.t -> public_key -> unit tzresult Lwt.t

(** Checks if the header that would be built from the given components
    is valid for the given diffculty. The signature is not passed as it
    is does not impact the proof-of-work stamp. The stamp is checked on
    the hash of a block header whose signature has been zeroed-out. *)
val check_header_proof_of_work_stamp :
  Block_header.shell_header -> Block_header.contents -> int64 -> bool

(** verify if the proof of work stamp is valid *)
val check_proof_of_work_stamp :
  context -> Block_header.t -> unit tzresult Lwt.t

(** check if the gap between the fitness of the current context
    and the given block is within the protocol parameters *)
val check_fitness_gap : context -> Block_header.t -> unit tzresult Lwt.t

val dawn_of_a_new_cycle : context -> Cycle.t option tzresult Lwt.t

val earlier_predecessor_timestamp :
  context -> Level.t -> Timestamp.t tzresult Lwt.t

(** Since Emmy+

    A block is valid only if its timestamp has a minimal delay with
    respect to the previous block's timestamp, and this minimal delay
    depends not only on the block's priority but also on the number of
    endorsement operations included in the block.

    In Emmy+, blocks' fitness increases by one unit with each level.

    In this way, Emmy+ simplifies the optimal baking strategy: The
    bakers used to have to choose whether to wait for more endorsements
    to include in their block, or to publish the block immediately,
    without waiting. The incentive for including more endorsements was
    to increase the fitness and win against unknown blocks. However,
    when a block was produced too late in the priority period, there
    was the risk that the block did not reach endorsers before the
    block of next priority. In Emmy+, the baker does not need to take
    such a decision, because the baker cannot publish a block too
    early. *)

(** Given a delay of a block's timestamp with respect to the minimum
    time to bake at the block's priority (as returned by
    `minimum_time`), it returns the minimum number of endorsements that
    the block has to contain *)
val minimum_allowed_endorsements : context -> block_delay:Period.t -> int

(** This is the somehow the dual of the previous function. Given a
    block priority and a number of endorsement slots (given by the
    `endorsing_power` argument), it returns the minimum time at which
    the next block can be baked. *)
val minimal_valid_time :
  context -> priority:int -> endorsing_power:int -> Time.t tzresult Lwt.t
baking_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

extensible_type

extensible_type

extensible_type

extensible_type

extensible_type

extensible_type

Parameter minimal_time :
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Z ->
    Tezos_protocol_environment_alpha__Environment.Time.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_protocol_environment_alpha__Environment.Time.t).

Parameter check_baking_rights :
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents ->
    Tezos_protocol_environment_alpha__Environment.Time.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Alpha_context.public_key *
            Tezos_raw_protocol_alpha.Alpha_context.Period.t)).

Parameter endorsement_rights :
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.Level.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
          (Tezos_raw_protocol_alpha.Alpha_context.public_key * list Z * bool))).

Parameter check_endorsement_rights :
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
    ->
    Tezos_raw_protocol_alpha.Alpha_context.Operation.t
      Tezos_raw_protocol_alpha.Alpha_context.Kind.endorsement ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Alpha_context.public_key_hash * list Z *
            bool)).

Parameter baking_reward :
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Z ->
    Z ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Alpha_context.Tez.t).

Parameter endorsing_reward :
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Z ->
    Z ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Alpha_context.Tez.t).

Parameter baking_priorities :
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.Level.t ->
    Tezos_raw_protocol_alpha.Misc.lazy_list
      Tezos_raw_protocol_alpha.Alpha_context.public_key.

Parameter first_baking_priorities :
Tezos_raw_protocol_alpha.Alpha_context.context ->
  option Z ->
    Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
      Tezos_raw_protocol_alpha.Alpha_context.Level.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (list Z)).

Parameter check_signature :
Tezos_raw_protocol_alpha.Alpha_context.Block_header.t ->
  Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
    ->
    Tezos_raw_protocol_alpha.Alpha_context.public_key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).

Parameter check_header_proof_of_work_stamp :
Tezos_raw_protocol_alpha.Alpha_context.Block_header.shell_header ->
  Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents -> int64 -> bool.

Parameter check_proof_of_work_stamp :
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.Block_header.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).

Parameter check_fitness_gap :
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.Block_header.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).

Parameter dawn_of_a_new_cycle :
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Alpha_context.Cycle.t)).

Parameter earlier_predecessor_timestamp :
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.Level.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Alpha_context.Timestamp.t).

Parameter minimum_allowed_endorsements :
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.Period.t -> Z.

Parameter minimal_valid_time :
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Z ->
    Z ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_protocol_environment_alpha__Environment.Time.t).
blinded_public_key_hash.ml 6 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

module H =
  Blake2B.Make
    (Base58)
    (struct
      let name = "Blinded public key hash"

      let title = "A blinded public key hash"

      let b58check_prefix = "\001\002\049\223"

      let size = Some Ed25519.Public_key_hash.size
    end)

include H

let () = Base58.check_encoded_prefix b58check_encoding "btz1" 37

let of_ed25519_pkh activation_code pkh =
  hash_bytes ~key:activation_code [Ed25519.Public_key_hash.to_bytes pkh]

type activation_code = MBytes.t

let activation_code_size = Ed25519.Public_key_hash.size

let activation_code_encoding = Data_encoding.Fixed.bytes activation_code_size

let activation_code_of_hex h =
  if Compare.Int.(String.length h <> activation_code_size * 2) then
    invalid_arg "Blinded_public_key_hash.activation_code_of_hex" ;
  MBytes.of_hex (`Hex h)

module Index = H
blinded_public_key_hash_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* ❌ Applications of functors are not handled. *)
functor_application

Export H.

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute Base58.check_encoded_prefix b58check_encoding "btz1" % string 37.

Definition of_ed25519_pkh
  (activation_code : Tezos_protocol_environment_alpha__Environment.MBytes.t)
  (pkh : Tezos_protocol_environment_alpha__Environment.Ed25519.Public_key_hash.t)
  : t :=
  hash_bytes (Some activation_code)
    (cons (Ed25519.Public_key_hash.to_bytes pkh) []).

Definition activation_code :=
  Tezos_protocol_environment_alpha__Environment.MBytes.t.

Definition activation_code_size : Z := Ed25519.Public_key_hash.size.

Definition activation_code_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    Tezos_protocol_environment_alpha__Environment.MBytes.t :=
  Data_encoding.Fixed.bytes activation_code_size.

Definition activation_code_of_hex (h : string)
  : Tezos_protocol_environment_alpha__Environment.MBytes.t :=
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    if
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_ltgt)
        (String.length h) (op_star activation_code_size 2) then
      invalid_arg "Blinded_public_key_hash.activation_code_of_hex" % string
    else
      tt in
  MBytes.of_hex
    (* ❌ Variants not supported *)
    variant.

Module Index := H.
blinded_public_key_hash.mli 3 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

include S.HASH

val encoding : t Data_encoding.t

val rpc_arg : t RPC_arg.t

type activation_code

val activation_code_encoding : activation_code Data_encoding.t

val of_ed25519_pkh : activation_code -> Ed25519.Public_key_hash.t -> t

val activation_code_of_hex : string -> activation_code

module Index : Storage_description.INDEX with type t = t
blinded_public_key_hash_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

include

Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.

Parameter rpc_arg : Tezos_protocol_environment_alpha__Environment.RPC_arg.t t.

Parameter activation_code : Type.

Parameter activation_code_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t activation_code.

Parameter of_ed25519_pkh :
activation_code ->
  Tezos_protocol_environment_alpha__Environment.Ed25519.Public_key_hash.t -> t.

Parameter activation_code_of_hex : string -> activation_code.

unhandled_module
block_header_repr.ml 6 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Block header *)

type t = {shell : Block_header.shell_header; protocol_data : protocol_data}

and protocol_data = {contents : contents; signature : Signature.t}

and contents = {
  priority : int;
  seed_nonce_hash : Nonce_hash.t option;
  proof_of_work_nonce : MBytes.t;
}

type block_header = t

type raw = Block_header.t

type shell_header = Block_header.shell_header

let raw_encoding = Block_header.encoding

let shell_header_encoding = Block_header.shell_header_encoding

let contents_encoding =
  let open Data_encoding in
  def "block_header.alpha.unsigned_contents"
  @@ conv
       (fun {priority; seed_nonce_hash; proof_of_work_nonce} ->
         (priority, proof_of_work_nonce, seed_nonce_hash))
       (fun (priority, proof_of_work_nonce, seed_nonce_hash) ->
         {priority; seed_nonce_hash; proof_of_work_nonce})
       (obj3
          (req "priority" uint16)
          (req
             "proof_of_work_nonce"
             (Fixed.bytes Constants_repr.proof_of_work_nonce_size))
          (opt "seed_nonce_hash" Nonce_hash.encoding))

let protocol_data_encoding =
  let open Data_encoding in
  def "block_header.alpha.signed_contents"
  @@ conv
       (fun {contents; signature} -> (contents, signature))
       (fun (contents, signature) -> {contents; signature})
       (merge_objs
          contents_encoding
          (obj1 (req "signature" Signature.encoding)))

let raw {shell; protocol_data} =
  let protocol_data =
    Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data
  in
  {Block_header.shell; protocol_data}

let unsigned_encoding =
  let open Data_encoding in
  merge_objs Block_header.shell_header_encoding contents_encoding

let encoding =
  let open Data_encoding in
  def "block_header.alpha.full_header"
  @@ conv
       (fun {shell; protocol_data} -> (shell, protocol_data))
       (fun (shell, protocol_data) -> {shell; protocol_data})
       (merge_objs Block_header.shell_header_encoding protocol_data_encoding)

(** Constants *)

let max_header_length =
  let fake_shell =
    {
      Block_header.level = 0l;
      proto_level = 0;
      predecessor = Block_hash.zero;
      timestamp = Time.of_seconds 0L;
      validation_passes = 0;
      operations_hash = Operation_list_list_hash.zero;
      fitness = Fitness_repr.from_int64 0L;
      context = Context_hash.zero;
    }
  and fake_contents =
    {
      priority = 0;
      proof_of_work_nonce =
        MBytes.create Constants_repr.proof_of_work_nonce_size;
      seed_nonce_hash = Some Nonce_hash.zero;
    }
  in
  Data_encoding.Binary.length
    encoding
    {
      shell = fake_shell;
      protocol_data = {contents = fake_contents; signature = Signature.zero};
    }

(** Header parsing entry point  *)

let hash_raw = Block_header.hash

let hash {shell; protocol_data} =
  Block_header.hash
    {
      shell;
      protocol_data =
        Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data;
    }
block_header_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Reserved Notation "'t".
Reserved Notation "'protocol_data".
Reserved Notation "'contents".

Record contents_skeleton {priority seed_nonce_hash proof_of_work_nonce : Type}
  := {
  priority : priority;
  seed_nonce_hash : seed_nonce_hash;
  proof_of_work_nonce : proof_of_work_nonce }.
Arguments contents_skeleton : clear implicits.

Record protocol_data_skeleton {contents signature : Type} := {
  contents : contents;
  signature : signature }.
Arguments protocol_data_skeleton : clear implicits.

Record t_skeleton {shell protocol_data : Type} := {
  shell : shell;
  protocol_data : protocol_data }.
Arguments t_skeleton : clear implicits.



where "'t" :=
  (t_skeleton
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header
    'protocol_data)
and "'protocol_data" :=
  (protocol_data_skeleton 'contents
    Tezos_protocol_environment_alpha__Environment.Signature.t)
and "'contents" :=
  (contents_skeleton Z (option Tezos_raw_protocol_alpha.Nonce_hash.t)
    Tezos_protocol_environment_alpha__Environment.MBytes.t).

Definition t := 't.
Definition protocol_data := 'protocol_data.
Definition contents := 'contents.

Definition block_header := t.

Definition raw := Tezos_protocol_environment_alpha__Environment.Block_header.t.

Definition shell_header :=
  Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.

Definition raw_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    Tezos_protocol_environment_alpha__Environment.Block_header.t :=
  Block_header.encoding.

Definition shell_header_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header :=
  Block_header.shell_header_encoding.

Definition contents_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    contents :=
  op_atat
    (let arg := def "block_header.alpha.unsigned_contents" % string in
    fun eta => arg None None eta)
    (conv
      (fun function_parameter =>
        let '{|
          priority := priority;
            seed_nonce_hash := seed_nonce_hash;
            proof_of_work_nonce := proof_of_work_nonce
            |} := function_parameter in
        (priority, proof_of_work_nonce, seed_nonce_hash))
      (fun function_parameter =>
        let '(priority, proof_of_work_nonce, seed_nonce_hash) :=
          function_parameter in
        {| priority := priority; seed_nonce_hash := seed_nonce_hash;
          proof_of_work_nonce := proof_of_work_nonce |}) None
      (obj3 (req None None "priority" % string uint16)
        (req None None "proof_of_work_nonce" % string
          (Fixed.bytes Constants_repr.proof_of_work_nonce_size))
        (opt None None "seed_nonce_hash" % string Nonce_hash.encoding))).

Definition protocol_data_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    protocol_data :=
  op_atat
    (let arg := def "block_header.alpha.signed_contents" % string in
    fun eta => arg None None eta)
    (conv
      (fun function_parameter =>
        let '{| contents := contents; signature := signature |} :=
          function_parameter in
        (contents, signature))
      (fun function_parameter =>
        let '(contents, signature) := function_parameter in
        {| contents := contents; signature := signature |}) None
      (merge_objs contents_encoding
        (obj1 (req None None "signature" % string Signature.encoding)))).

Definition raw (function_parameter : t)
  : Tezos_protocol_environment_alpha__Environment.Block_header.t :=
  let '{| shell := shell; protocol_data := protocol_data |} :=
    function_parameter in
  let protocol_data :=
    Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data in
  {| Block_header.shell := shell; Block_header.protocol_data := protocol_data |}.

Definition unsigned_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (Tezos_protocol_environment_alpha__Environment.Block_header.shell_header *
      contents) :=
  merge_objs Block_header.shell_header_encoding contents_encoding.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
  op_atat
    (let arg := def "block_header.alpha.full_header" % string in
    fun eta => arg None None eta)
    (conv
      (fun function_parameter =>
        let '{| shell := shell; protocol_data := protocol_data |} :=
          function_parameter in
        (shell, protocol_data))
      (fun function_parameter =>
        let '(shell, protocol_data) := function_parameter in
        {| shell := shell; protocol_data := protocol_data |}) None
      (merge_objs Block_header.shell_header_encoding protocol_data_encoding)).

Definition max_header_length : Z :=
  let fake_shell
    : Tezos_protocol_environment_alpha__Environment.Block_header.shell_header :=
    {|
      Block_header.level :=
        (* ❌ Constant of type int32 is converted to int *)
        0; Block_header.proto_level := 0;
      Block_header.predecessor :=
        Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.zero);
      Block_header.timestamp :=
        Time.of_seconds
          (* ❌ Constant of type int64 is converted to int *)
          0; Block_header.validation_passes := 0;
      Block_header.operations_hash :=
        Tezos_protocol_environment_alpha__Environment.Operation_list_list_hash.(Tezos_protocol_environment_alpha__Environment.MERKLE_TREE.S.zero);
      Block_header.fitness :=
        Fitness_repr.from_int64
          (* ❌ Constant of type int64 is converted to int *)
          0;
      Block_header.context :=
        Tezos_protocol_environment_alpha__Environment.Context_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.zero)
      |}
  with fake_contents : contents :=
    {| priority := 0; seed_nonce_hash := Some Nonce_hash.zero;
      proof_of_work_nonce :=
        MBytes.create Constants_repr.proof_of_work_nonce_size |} in
  Data_encoding.Binary.length encoding
    {| shell := fake_shell;
      protocol_data :=
        {| contents := fake_contents; signature := Signature.zero |} |}.

Definition hash_raw
  : Tezos_protocol_environment_alpha__Environment.Block_header.t ->
    Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t) :=
  Block_header.hash.

Definition hash (function_parameter : t)
  : Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t) :=
  let '{| shell := shell; protocol_data := protocol_data |} :=
    function_parameter in
  Block_header.hash
    {| shell := shell;
      protocol_data :=
        Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data
      |}.
block_header_repr.mli 3 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = {shell : Block_header.shell_header; protocol_data : protocol_data}

and protocol_data = {contents : contents; signature : Signature.t}

and contents = {
  priority : int;
  seed_nonce_hash : Nonce_hash.t option;
  proof_of_work_nonce : MBytes.t;
}

type block_header = t

type raw = Block_header.t

type shell_header = Block_header.shell_header

val raw : block_header -> raw

val encoding : block_header Data_encoding.encoding

val raw_encoding : raw Data_encoding.t

val contents_encoding : contents Data_encoding.t

val unsigned_encoding : (Block_header.shell_header * contents) Data_encoding.t

val protocol_data_encoding : protocol_data Data_encoding.encoding

val shell_header_encoding : shell_header Data_encoding.encoding

(** The maximum size of block headers in bytes *)
val max_header_length : int

val hash : block_header -> Block_hash.t

val hash_raw : raw -> Block_hash.t
block_header_repr_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Reserved Notation "'t".
Reserved Notation "'protocol_data".
Reserved Notation "'contents".

Record contents_skeleton {priority seed_nonce_hash proof_of_work_nonce : Type}
  := {
  priority : priority;
  seed_nonce_hash : seed_nonce_hash;
  proof_of_work_nonce : proof_of_work_nonce }.
Arguments contents_skeleton : clear implicits.

Record protocol_data_skeleton {contents signature : Type} := {
  contents : contents;
  signature : signature }.
Arguments protocol_data_skeleton : clear implicits.

Record t_skeleton {shell protocol_data : Type} := {
  shell : shell;
  protocol_data : protocol_data }.
Arguments t_skeleton : clear implicits.



where "'t" :=
  (t_skeleton
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header
    'protocol_data)
and "'protocol_data" :=
  (protocol_data_skeleton 'contents
    Tezos_protocol_environment_alpha__Environment.Signature.t)
and "'contents" :=
  (contents_skeleton Z (option Tezos_raw_protocol_alpha.Nonce_hash.t)
    Tezos_protocol_environment_alpha__Environment.MBytes.t).

Definition t := 't.
Definition protocol_data := 'protocol_data.
Definition contents := 'contents.

Definition block_header := t.

Definition raw := Tezos_protocol_environment_alpha__Environment.Block_header.t.

Definition shell_header :=
  Tezos_protocol_environment_alpha__Environment.Block_header.shell_header.

Parameter raw : block_header -> raw.

Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
  block_header.

Parameter raw_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t raw.

Parameter contents_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t contents.

Parameter unsigned_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
  (Tezos_protocol_environment_alpha__Environment.Block_header.shell_header *
    contents).

Parameter protocol_data_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
  protocol_data.

Parameter shell_header_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
  shell_header.

Parameter max_header_length : Z.

Parameter hash :
block_header ->
  Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t).

Parameter hash_raw :
raw ->
  Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t).
bootstrap_storage.ml 6 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Misc

let init_account ctxt
    ({public_key_hash; public_key; amount} : Parameters_repr.bootstrap_account)
    =
  let contract = Contract_repr.implicit_contract public_key_hash in
  Contract_storage.credit ctxt contract amount
  >>=? fun ctxt ->
  match public_key with
  | Some public_key ->
      Contract_storage.reveal_manager_key ctxt public_key_hash public_key
      >>=? fun ctxt ->
      Delegate_storage.set ctxt contract (Some public_key_hash)
      >>=? fun ctxt -> return ctxt
  | None ->
      return ctxt

let init_contract ~typecheck ctxt
    ({delegate; amount; script} : Parameters_repr.bootstrap_contract) =
  Contract_storage.fresh_contract_from_current_nonce ctxt
  >>=? fun (ctxt, contract) ->
  typecheck ctxt script
  >>=? fun (script, ctxt) ->
  Contract_storage.originate
    ctxt
    contract
    ~balance:amount
    ~prepaid_bootstrap_storage:true
    ~script
    ~delegate:(Some delegate)
  >>=? fun ctxt -> return ctxt

let init ctxt ~typecheck ?ramp_up_cycles ?no_reward_cycles accounts contracts =
  let nonce =
    Operation_hash.hash_bytes [MBytes.of_string "Un festival de GADT."]
  in
  let ctxt = Raw_context.init_origination_nonce ctxt nonce in
  fold_left_s init_account ctxt accounts
  >>=? fun ctxt ->
  fold_left_s (init_contract ~typecheck) ctxt contracts
  >>=? fun ctxt ->
  ( match no_reward_cycles with
  | None ->
      return ctxt
  | Some cycles ->
      (* Store pending ramp ups. *)
      let constants = Raw_context.constants ctxt in
      (* Start without reward *)
      Raw_context.patch_constants ctxt (fun c ->
          {
            c with
            block_reward = Tez_repr.zero;
            endorsement_reward = Tez_repr.zero;
          })
      >>= fun ctxt ->
      (* Store the final reward. *)
      Storage.Ramp_up.Rewards.init
        ctxt
        (Cycle_repr.of_int32_exn (Int32.of_int cycles))
        (constants.block_reward, constants.endorsement_reward) )
  >>=? fun ctxt ->
  match ramp_up_cycles with
  | None ->
      return ctxt
  | Some cycles ->
      (* Store pending ramp ups. *)
      let constants = Raw_context.constants ctxt in
      Lwt.return
        Tez_repr.(constants.block_security_deposit /? Int64.of_int cycles)
      >>=? fun block_step ->
      Lwt.return
        Tez_repr.(
          constants.endorsement_security_deposit /? Int64.of_int cycles)
      >>=? fun endorsement_step ->
      (* Start without security_deposit *)
      Raw_context.patch_constants ctxt (fun c ->
          {
            c with
            block_security_deposit = Tez_repr.zero;
            endorsement_security_deposit = Tez_repr.zero;
          })
      >>= fun ctxt ->
      fold_left_s
        (fun ctxt cycle ->
          Lwt.return Tez_repr.(block_step *? Int64.of_int cycle)
          >>=? fun block_security_deposit ->
          Lwt.return Tez_repr.(endorsement_step *? Int64.of_int cycle)
          >>=? fun endorsement_security_deposit ->
          let cycle = Cycle_repr.of_int32_exn (Int32.of_int cycle) in
          Storage.Ramp_up.Security_deposits.init
            ctxt
            cycle
            (block_security_deposit, endorsement_security_deposit))
        ctxt
        (1 --> (cycles - 1))
      >>=? fun ctxt ->
      (* Store the final security deposits. *)
      Storage.Ramp_up.Security_deposits.init
        ctxt
        (Cycle_repr.of_int32_exn (Int32.of_int cycles))
        ( constants.block_security_deposit,
          constants.endorsement_security_deposit )
      >>=? fun ctxt -> return ctxt

let cycle_end ctxt last_cycle =
  let next_cycle = Cycle_repr.succ last_cycle in
  Storage.Ramp_up.Rewards.get_option ctxt next_cycle
  >>=? (function
         | None ->
             return ctxt
         | Some (block_reward, endorsement_reward) ->
             Storage.Ramp_up.Rewards.delete ctxt next_cycle
             >>=? fun ctxt ->
             Raw_context.patch_constants ctxt (fun c ->
                 {c with block_reward; endorsement_reward})
             >>= fun ctxt -> return ctxt)
  >>=? fun ctxt ->
  Storage.Ramp_up.Security_deposits.get_option ctxt next_cycle
  >>=? function
  | None ->
      return ctxt
  | Some (block_security_deposit, endorsement_security_deposit) ->
      Storage.Ramp_up.Security_deposits.delete ctxt next_cycle
      >>=? fun ctxt ->
      Raw_context.patch_constants ctxt (fun c ->
          {c with block_security_deposit; endorsement_security_deposit})
      >>= fun ctxt -> return ctxt
bootstrap_storage_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Misc.

Definition init_account
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (function_parameter :
    Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_account)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let '{|
    public_key_hash := public_key_hash;
      public_key := public_key;
      amount := amount
      |} := function_parameter in
  let contract := Contract_repr.implicit_contract public_key_hash in
  op_gtgteqquestion (Contract_storage.credit ctxt contract amount)
    (fun ctxt =>
      match public_key with
      | Some public_key =>
        op_gtgteqquestion
          (Contract_storage.reveal_manager_key ctxt public_key_hash public_key)
          (fun ctxt =>
            op_gtgteqquestion
              (Delegate_storage.set ctxt contract (Some public_key_hash))
              (fun ctxt => __return ctxt))
      | None => __return ctxt
      end).

Definition init_contract
  (typecheck :
    Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_raw_protocol_alpha.Script_repr.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            ((Tezos_raw_protocol_alpha.Script_repr.t *
              option Tezos_raw_protocol_alpha.Contract_storage.big_map_diff) *
              Tezos_raw_protocol_alpha.Raw_context.t)))
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (function_parameter :
    Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let '{| delegate := delegate; amount := amount; script := script |} :=
    function_parameter in
  op_gtgteqquestion (Contract_storage.fresh_contract_from_current_nonce ctxt)
    (fun function_parameter =>
      let '(ctxt, contract) := function_parameter in
      op_gtgteqquestion (typecheck ctxt script)
        (fun function_parameter =>
          let '(script, ctxt) := function_parameter in
          op_gtgteqquestion
            (Contract_storage.originate ctxt (Some true) contract amount script
              (Some delegate)) (fun ctxt => __return ctxt))).

Definition init
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (typecheck :
    Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_raw_protocol_alpha.Script_repr.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            ((Tezos_raw_protocol_alpha.Script_repr.t *
              option Tezos_raw_protocol_alpha.Contract_storage.big_map_diff) *
              Tezos_raw_protocol_alpha.Raw_context.t)))
  (ramp_up_cycles : option Z) (no_reward_cycles : option Z)
  (accounts : list Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_account)
  (contracts : list Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let nonce :=
    Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.hash_bytes)
      None (cons (MBytes.of_string "Un festival de GADT." % string) []) in
  let ctxt := Raw_context.init_origination_nonce ctxt nonce in
  op_gtgteqquestion (fold_left_s init_account ctxt accounts)
    (fun ctxt =>
      op_gtgteqquestion (fold_left_s (init_contract typecheck) ctxt contracts)
        (fun ctxt =>
          op_gtgteqquestion
            match no_reward_cycles with
            | None => __return ctxt
            | Some cycles =>
              let constants := Raw_context.constants ctxt in
              op_gtgteq
                (Raw_context.patch_constants ctxt
                  (fun c =>
                    (* ❌ Record substitution not handled *)
                    record_substitution))
                (fun ctxt =>
                  Storage.Ramp_up.Rewards.init ctxt
                    (Cycle_repr.of_int32_exn (Int32.of_int cycles))
                    ((block_reward constants), (endorsement_reward constants)))
            end
            (fun ctxt =>
              match ramp_up_cycles with
              | None => __return ctxt
              | Some cycles =>
                let constants := Raw_context.constants ctxt in
                op_gtgteqquestion
                  (Lwt.__return
                    (op_divquestion (block_security_deposit constants)
                      (Int64.of_int cycles)))
                  (fun block_step =>
                    op_gtgteqquestion
                      (Lwt.__return
                        (op_divquestion (endorsement_security_deposit constants)
                          (Int64.of_int cycles)))
                      (fun endorsement_step =>
                        op_gtgteq
                          (Raw_context.patch_constants ctxt
                            (fun c =>
                              (* ❌ Record substitution not handled *)
                              record_substitution))
                          (fun ctxt =>
                            op_gtgteqquestion
                              (fold_left_s
                                (fun ctxt =>
                                  fun cycle =>
                                    op_gtgteqquestion
                                      (Lwt.__return
                                        (op_starquestion block_step
                                          (Int64.of_int cycle)))
                                      (fun block_security_deposit =>
                                        op_gtgteqquestion
                                          (Lwt.__return
                                            (op_starquestion endorsement_step
                                              (Int64.of_int cycle)))
                                          (fun endorsement_security_deposit =>
                                            let cycle :=
                                              Cycle_repr.of_int32_exn
                                                (Int32.of_int cycle) in
                                            Storage.Ramp_up.Security_deposits.init
                                              ctxt cycle
                                              (block_security_deposit,
                                                endorsement_security_deposit))))
                                ctxt (op_minusminusgt 1 (op_minus cycles 1)))
                              (fun ctxt =>
                                op_gtgteqquestion
                                  (Storage.Ramp_up.Security_deposits.init ctxt
                                    (Cycle_repr.of_int32_exn
                                      (Int32.of_int cycles))
                                    ((block_security_deposit constants),
                                      (endorsement_security_deposit constants)))
                                  (fun ctxt => __return ctxt)))))
              end))).

Definition cycle_end
  (ctxt : Tezos_raw_protocol_alpha.Storage.Ramp_up.Rewards.context)
  (last_cycle : Tezos_raw_protocol_alpha.Cycle_repr.cycle)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Ramp_up.Rewards.context) :=
  let next_cycle := Cycle_repr.succ last_cycle in
  op_gtgteqquestion
    (op_gtgteqquestion (Storage.Ramp_up.Rewards.get_option ctxt next_cycle)
      (fun function_parameter =>
        match function_parameter with
        | None => __return ctxt
        | Some (block_reward, endorsement_reward) =>
          op_gtgteqquestion (Storage.Ramp_up.Rewards.delete ctxt next_cycle)
            (fun ctxt =>
              op_gtgteq
                (Raw_context.patch_constants ctxt
                  (fun c =>
                    (* ❌ Record substitution not handled *)
                    record_substitution)) (fun ctxt => __return ctxt))
        end))
    (fun ctxt =>
      op_gtgteqquestion
        (Storage.Ramp_up.Security_deposits.get_option ctxt next_cycle)
        (fun function_parameter =>
          match function_parameter with
          | None => __return ctxt
          | Some (block_security_deposit, endorsement_security_deposit) =>
            op_gtgteqquestion
              (Storage.Ramp_up.Security_deposits.delete ctxt next_cycle)
              (fun ctxt =>
                op_gtgteq
                  (Raw_context.patch_constants ctxt
                    (fun c =>
                      (* ❌ Record substitution not handled *)
                      record_substitution)) (fun ctxt => __return ctxt))
          end)).
bootstrap_storage.mli 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

val init :
  Raw_context.t ->
  typecheck:(Raw_context.t ->
            Script_repr.t ->
            ( (Script_repr.t * Contract_storage.big_map_diff option)
            * Raw_context.t )
            tzresult
            Lwt.t) ->
  ?ramp_up_cycles:int ->
  ?no_reward_cycles:int ->
  Parameters_repr.bootstrap_account list ->
  Parameters_repr.bootstrap_contract list ->
  Raw_context.t tzresult Lwt.t

val cycle_end : Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t
bootstrap_storage_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter init :
Tezos_raw_protocol_alpha.Raw_context.t ->
  (Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_raw_protocol_alpha.Script_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          ((Tezos_raw_protocol_alpha.Script_repr.t *
            option Tezos_raw_protocol_alpha.Contract_storage.big_map_diff) *
            Tezos_raw_protocol_alpha.Raw_context.t))) ->
    option Z ->
      option Z ->
        list Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_account ->
          list Tezos_raw_protocol_alpha.Parameters_repr.bootstrap_contract ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                Tezos_raw_protocol_alpha.Raw_context.t).

Parameter cycle_end :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).
commitment_repr.ml 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = {
  blinded_public_key_hash : Blinded_public_key_hash.t;
  amount : Tez_repr.t;
}

let encoding =
  let open Data_encoding in
  conv
    (fun {blinded_public_key_hash; amount} ->
      (blinded_public_key_hash, amount))
    (fun (blinded_public_key_hash, amount) ->
      {blinded_public_key_hash; amount})
    (tup2 Blinded_public_key_hash.encoding Tez_repr.encoding)
commitment_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Record t := {
  blinded_public_key_hash : Tezos_raw_protocol_alpha.Blinded_public_key_hash.t;
  amount : Tezos_raw_protocol_alpha.Tez_repr.t }.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
  conv
    (fun function_parameter =>
      let '{|
        blinded_public_key_hash := blinded_public_key_hash;
          amount := amount
          |} := function_parameter in
      (blinded_public_key_hash, amount))
    (fun function_parameter =>
      let '(blinded_public_key_hash, amount) := function_parameter in
      {| blinded_public_key_hash := blinded_public_key_hash; amount := amount |})
    None (tup2 Blinded_public_key_hash.encoding Tez_repr.encoding).
commitment_repr.mli 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = {
  blinded_public_key_hash : Blinded_public_key_hash.t;
  amount : Tez_repr.t;
}

val encoding : t Data_encoding.t
commitment_repr_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Record t := {
  blinded_public_key_hash : Tezos_raw_protocol_alpha.Blinded_public_key_hash.t;
  amount : Tezos_raw_protocol_alpha.Tez_repr.t }.

Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
commitment_storage.ml 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

let get_opt = Storage.Commitments.get_option

let delete = Storage.Commitments.delete

let init ctxt commitments =
  let init_commitment ctxt Commitment_repr.{blinded_public_key_hash; amount} =
    Storage.Commitments.init ctxt blinded_public_key_hash amount
  in
  fold_left_s init_commitment ctxt commitments >>=? fun ctxt -> return ctxt
commitment_storage_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition get_opt
  : Tezos_raw_protocol_alpha.Storage.Commitments.context ->
    Tezos_raw_protocol_alpha.Storage.Commitments.key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option Tezos_raw_protocol_alpha.Storage.Commitments.value)) :=
  Storage.Commitments.get_option.

Definition delete
  : Tezos_raw_protocol_alpha.Storage.Commitments.context ->
    Tezos_raw_protocol_alpha.Storage.Commitments.key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t) := Storage.Commitments.delete.

Definition init
  (ctxt : Tezos_raw_protocol_alpha.Storage.Commitments.context)
  (commitments : list Tezos_raw_protocol_alpha.Commitment_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Commitments.context) :=
  let init_commitment
    (ctxt : Tezos_raw_protocol_alpha.Storage.Commitments.context)
    (function_parameter : Tezos_raw_protocol_alpha.Commitment_repr.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t) :=
    let '{|
      blinded_public_key_hash := blinded_public_key_hash;
        amount := amount
        |} := function_parameter in
    Storage.Commitments.init ctxt blinded_public_key_hash amount in
  op_gtgteqquestion (fold_left_s init_commitment ctxt commitments)
    (fun ctxt => __return ctxt).
commitment_storage.mli 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

val init :
  Raw_context.t -> Commitment_repr.t list -> Raw_context.t tzresult Lwt.t

val get_opt :
  Raw_context.t ->
  Blinded_public_key_hash.t ->
  Tez_repr.t option tzresult Lwt.t

val delete :
  Raw_context.t -> Blinded_public_key_hash.t -> Raw_context.t tzresult Lwt.t
commitment_storage_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter init :
Tezos_raw_protocol_alpha.Raw_context.t ->
  list Tezos_raw_protocol_alpha.Commitment_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).

Parameter get_opt :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Blinded_public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (option Tezos_raw_protocol_alpha.Tez_repr.t)).

Parameter delete :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Blinded_public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).
constants_repr.ml 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

let version_number_004 = "\000"

let version_number = "\001"

let proof_of_work_nonce_size = 8

let nonce_length = 32

let max_revelations_per_block = 32

let max_proposals_per_delegate = 20

let max_operation_data_length = 16 * 1024 (* 16kB *)

type fixed = {
  proof_of_work_nonce_size : int;
  nonce_length : int;
  max_revelations_per_block : int;
  max_operation_data_length : int;
  max_proposals_per_delegate : int;
}

let fixed_encoding =
  let open Data_encoding in
  conv
    (fun c ->
      ( c.proof_of_work_nonce_size,
        c.nonce_length,
        c.max_revelations_per_block,
        c.max_operation_data_length,
        c.max_proposals_per_delegate ))
    (fun ( proof_of_work_nonce_size,
           nonce_length,
           max_revelations_per_block,
           max_operation_data_length,
           max_proposals_per_delegate ) ->
      {
        proof_of_work_nonce_size;
        nonce_length;
        max_revelations_per_block;
        max_operation_data_length;
        max_proposals_per_delegate;
      })
    (obj5
       (req "proof_of_work_nonce_size" uint8)
       (req "nonce_length" uint8)
       (req "max_revelations_per_block" uint8)
       (req "max_operation_data_length" int31)
       (req "max_proposals_per_delegate" uint8))

let fixed =
  {
    proof_of_work_nonce_size;
    nonce_length;
    max_revelations_per_block;
    max_operation_data_length;
    max_proposals_per_delegate;
  }

type parametric = {
  preserved_cycles : int;
  blocks_per_cycle : int32;
  blocks_per_commitment : int32;
  blocks_per_roll_snapshot : int32;
  blocks_per_voting_period : int32;
  time_between_blocks : Period_repr.t list;
  endorsers_per_block : int;
  hard_gas_limit_per_operation : Z.t;
  hard_gas_limit_per_block : Z.t;
  proof_of_work_threshold : int64;
  tokens_per_roll : Tez_repr.t;
  michelson_maximum_type_size : int;
  seed_nonce_revelation_tip : Tez_repr.t;
  origination_size : int;
  block_security_deposit : Tez_repr.t;
  endorsement_security_deposit : Tez_repr.t;
  block_reward : Tez_repr.t;
  endorsement_reward : Tez_repr.t;
  cost_per_byte : Tez_repr.t;
  hard_storage_limit_per_operation : Z.t;
  test_chain_duration : int64;
  (* in seconds *)
  quorum_min : int32;
  quorum_max : int32;
  min_proposal_quorum : int32;
  initial_endorsers : int;
  delay_per_missing_endorsement : Period_repr.t;
}

let parametric_encoding =
  let open Data_encoding in
  conv
    (fun c ->
      ( ( c.preserved_cycles,
          c.blocks_per_cycle,
          c.blocks_per_commitment,
          c.blocks_per_roll_snapshot,
          c.blocks_per_voting_period,
          c.time_between_blocks,
          c.endorsers_per_block,
          c.hard_gas_limit_per_operation,
          c.hard_gas_limit_per_block ),
        ( ( c.proof_of_work_threshold,
            c.tokens_per_roll,
            c.michelson_maximum_type_size,
            c.seed_nonce_revelation_tip,
            c.origination_size,
            c.block_security_deposit,
            c.endorsement_security_deposit,
            c.block_reward ),
          ( c.endorsement_reward,
            c.cost_per_byte,
            c.hard_storage_limit_per_operation,
            c.test_chain_duration,
            c.quorum_min,
            c.quorum_max,
            c.min_proposal_quorum,
            c.initial_endorsers,
            c.delay_per_missing_endorsement ) ) ))
    (fun ( ( preserved_cycles,
             blocks_per_cycle,
             blocks_per_commitment,
             blocks_per_roll_snapshot,
             blocks_per_voting_period,
             time_between_blocks,
             endorsers_per_block,
             hard_gas_limit_per_operation,
             hard_gas_limit_per_block ),
           ( ( proof_of_work_threshold,
               tokens_per_roll,
               michelson_maximum_type_size,
               seed_nonce_revelation_tip,
               origination_size,
               block_security_deposit,
               endorsement_security_deposit,
               block_reward ),
             ( endorsement_reward,
               cost_per_byte,
               hard_storage_limit_per_operation,
               test_chain_duration,
               quorum_min,
               quorum_max,
               min_proposal_quorum,
               initial_endorsers,
               delay_per_missing_endorsement ) ) ) ->
      {
        preserved_cycles;
        blocks_per_cycle;
        blocks_per_commitment;
        blocks_per_roll_snapshot;
        blocks_per_voting_period;
        time_between_blocks;
        endorsers_per_block;
        hard_gas_limit_per_operation;
        hard_gas_limit_per_block;
        proof_of_work_threshold;
        tokens_per_roll;
        michelson_maximum_type_size;
        seed_nonce_revelation_tip;
        origination_size;
        block_security_deposit;
        endorsement_security_deposit;
        block_reward;
        endorsement_reward;
        cost_per_byte;
        hard_storage_limit_per_operation;
        test_chain_duration;
        quorum_min;
        quorum_max;
        min_proposal_quorum;
        initial_endorsers;
        delay_per_missing_endorsement;
      })
    (merge_objs
       (obj9
          (req "preserved_cycles" uint8)
          (req "blocks_per_cycle" int32)
          (req "blocks_per_commitment" int32)
          (req "blocks_per_roll_snapshot" int32)
          (req "blocks_per_voting_period" int32)
          (req "time_between_blocks" (list Period_repr.encoding))
          (req "endorsers_per_block" uint16)
          (req "hard_gas_limit_per_operation" z)
          (req "hard_gas_limit_per_block" z))
       (merge_objs
          (obj8
             (req "proof_of_work_threshold" int64)
             (req "tokens_per_roll" Tez_repr.encoding)
             (req "michelson_maximum_type_size" uint16)
             (req "seed_nonce_revelation_tip" Tez_repr.encoding)
             (req "origination_size" int31)
             (req "block_security_deposit" Tez_repr.encoding)
             (req "endorsement_security_deposit" Tez_repr.encoding)
             (req "block_reward" Tez_repr.encoding))
          (obj9
             (req "endorsement_reward" Tez_repr.encoding)
             (req "cost_per_byte" Tez_repr.encoding)
             (req "hard_storage_limit_per_operation" z)
             (req "test_chain_duration" int64)
             (req "quorum_min" int32)
             (req "quorum_max" int32)
             (req "min_proposal_quorum" int32)
             (req "initial_endorsers" uint16)
             (req "delay_per_missing_endorsement" Period_repr.encoding))))

type t = {fixed : fixed; parametric : parametric}

let encoding =
  let open Data_encoding in
  conv
    (fun {fixed; parametric} -> (fixed, parametric))
    (fun (fixed, parametric) -> {fixed; parametric})
    (merge_objs fixed_encoding parametric_encoding)
constants_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition version_number_004 : string := "" % string.

Definition version_number : string := "" % string.

Definition proof_of_work_nonce_size : Z := 8.

Definition nonce_length : Z := 32.

Definition max_revelations_per_block : Z := 32.

Definition max_proposals_per_delegate : Z := 20.

Definition max_operation_data_length : Z := op_star 16 1024.

Record fixed := {
  proof_of_work_nonce_size : Z;
  nonce_length : Z;
  max_revelations_per_block : Z;
  max_operation_data_length : Z;
  max_proposals_per_delegate : Z }.

Definition fixed_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding fixed :=
  conv
    (fun c =>
      ((proof_of_work_nonce_size c), (nonce_length c),
        (max_revelations_per_block c), (max_operation_data_length c),
        (max_proposals_per_delegate c)))
    (fun function_parameter =>
      let
        '(proof_of_work_nonce_size, nonce_length, max_revelations_per_block,
          max_operation_data_length, max_proposals_per_delegate) :=
        function_parameter in
      {| proof_of_work_nonce_size := proof_of_work_nonce_size;
        nonce_length := nonce_length;
        max_revelations_per_block := max_revelations_per_block;
        max_operation_data_length := max_operation_data_length;
        max_proposals_per_delegate := max_proposals_per_delegate |}) None
    (obj5 (req None None "proof_of_work_nonce_size" % string uint8)
      (req None None "nonce_length" % string uint8)
      (req None None "max_revelations_per_block" % string uint8)
      (req None None "max_operation_data_length" % string int31)
      (req None None "max_proposals_per_delegate" % string uint8)).

Definition fixed : fixed :=
  {| proof_of_work_nonce_size := proof_of_work_nonce_size;
    nonce_length := nonce_length;
    max_revelations_per_block := max_revelations_per_block;
    max_operation_data_length := max_operation_data_length;
    max_proposals_per_delegate := max_proposals_per_delegate |}.

Record parametric := {
  preserved_cycles : Z;
  blocks_per_cycle : int32;
  blocks_per_commitment : int32;
  blocks_per_roll_snapshot : int32;
  blocks_per_voting_period : int32;
  time_between_blocks : list Tezos_raw_protocol_alpha.Period_repr.t;
  endorsers_per_block : Z;
  hard_gas_limit_per_operation :
    Tezos_protocol_environment_alpha__Environment.Z.t;
  hard_gas_limit_per_block : Tezos_protocol_environment_alpha__Environment.Z.t;
  proof_of_work_threshold : int64;
  tokens_per_roll : Tezos_raw_protocol_alpha.Tez_repr.t;
  michelson_maximum_type_size : Z;
  seed_nonce_revelation_tip : Tezos_raw_protocol_alpha.Tez_repr.t;
  origination_size : Z;
  block_security_deposit : Tezos_raw_protocol_alpha.Tez_repr.t;
  endorsement_security_deposit : Tezos_raw_protocol_alpha.Tez_repr.t;
  block_reward : Tezos_raw_protocol_alpha.Tez_repr.t;
  endorsement_reward : Tezos_raw_protocol_alpha.Tez_repr.t;
  cost_per_byte : Tezos_raw_protocol_alpha.Tez_repr.t;
  hard_storage_limit_per_operation :
    Tezos_protocol_environment_alpha__Environment.Z.t;
  test_chain_duration : int64;
  quorum_min : int32;
  quorum_max : int32;
  min_proposal_quorum : int32;
  initial_endorsers : Z;
  delay_per_missing_endorsement : Tezos_raw_protocol_alpha.Period_repr.t }.

Definition parametric_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    parametric :=
  conv
    (fun c =>
      (((preserved_cycles c), (blocks_per_cycle c), (blocks_per_commitment c),
        (blocks_per_roll_snapshot c), (blocks_per_voting_period c),
        (time_between_blocks c), (endorsers_per_block c),
        (hard_gas_limit_per_operation c), (hard_gas_limit_per_block c)),
        (((proof_of_work_threshold c), (tokens_per_roll c),
          (michelson_maximum_type_size c), (seed_nonce_revelation_tip c),
          (origination_size c), (block_security_deposit c),
          (endorsement_security_deposit c), (block_reward c)),
          ((endorsement_reward c), (cost_per_byte c),
            (hard_storage_limit_per_operation c), (test_chain_duration c),
            (quorum_min c), (quorum_max c), (min_proposal_quorum c),
            (initial_endorsers c), (delay_per_missing_endorsement c)))))
    (fun function_parameter =>
      let
        '((preserved_cycles, blocks_per_cycle, blocks_per_commitment,
          blocks_per_roll_snapshot, blocks_per_voting_period,
          time_between_blocks, endorsers_per_block,
          hard_gas_limit_per_operation, hard_gas_limit_per_block),
          ((proof_of_work_threshold, tokens_per_roll,
            michelson_maximum_type_size, seed_nonce_revelation_tip,
            origination_size, block_security_deposit,
            endorsement_security_deposit, block_reward),
            (endorsement_reward, cost_per_byte,
              hard_storage_limit_per_operation, test_chain_duration, quorum_min,
              quorum_max, min_proposal_quorum, initial_endorsers,
              delay_per_missing_endorsement))) := function_parameter in
      {| preserved_cycles := preserved_cycles;
        blocks_per_cycle := blocks_per_cycle;
        blocks_per_commitment := blocks_per_commitment;
        blocks_per_roll_snapshot := blocks_per_roll_snapshot;
        blocks_per_voting_period := blocks_per_voting_period;
        time_between_blocks := time_between_blocks;
        endorsers_per_block := endorsers_per_block;
        hard_gas_limit_per_operation := hard_gas_limit_per_operation;
        hard_gas_limit_per_block := hard_gas_limit_per_block;
        proof_of_work_threshold := proof_of_work_threshold;
        tokens_per_roll := tokens_per_roll;
        michelson_maximum_type_size := michelson_maximum_type_size;
        seed_nonce_revelation_tip := seed_nonce_revelation_tip;
        origination_size := origination_size;
        block_security_deposit := block_security_deposit;
        endorsement_security_deposit := endorsement_security_deposit;
        block_reward := block_reward; endorsement_reward := endorsement_reward;
        cost_per_byte := cost_per_byte;
        hard_storage_limit_per_operation := hard_storage_limit_per_operation;
        test_chain_duration := test_chain_duration; quorum_min := quorum_min;
        quorum_max := quorum_max; min_proposal_quorum := min_proposal_quorum;
        initial_endorsers := initial_endorsers;
        delay_per_missing_endorsement := delay_per_missing_endorsement |}) None
    (merge_objs
      (obj9 (req None None "preserved_cycles" % string uint8)
        (req None None "blocks_per_cycle" % string int32)
        (req None None "blocks_per_commitment" % string int32)
        (req None None "blocks_per_roll_snapshot" % string int32)
        (req None None "blocks_per_voting_period" % string int32)
        (req None None "time_between_blocks" % string
          (list None Period_repr.encoding))
        (req None None "endorsers_per_block" % string uint16)
        (req None None "hard_gas_limit_per_operation" % string z)
        (req None None "hard_gas_limit_per_block" % string z))
      (merge_objs
        (obj8 (req None None "proof_of_work_threshold" % string int64)
          (req None None "tokens_per_roll" % string Tez_repr.encoding)
          (req None None "michelson_maximum_type_size" % string uint16)
          (req None None "seed_nonce_revelation_tip" % string Tez_repr.encoding)
          (req None None "origination_size" % string int31)
          (req None None "block_security_deposit" % string Tez_repr.encoding)
          (req None None "endorsement_security_deposit" % string
            Tez_repr.encoding)
          (req None None "block_reward" % string Tez_repr.encoding))
        (obj9 (req None None "endorsement_reward" % string Tez_repr.encoding)
          (req None None "cost_per_byte" % string Tez_repr.encoding)
          (req None None "hard_storage_limit_per_operation" % string z)
          (req None None "test_chain_duration" % string int64)
          (req None None "quorum_min" % string int32)
          (req None None "quorum_max" % string int32)
          (req None None "min_proposal_quorum" % string int32)
          (req None None "initial_endorsers" % string uint16)
          (req None None "delay_per_missing_endorsement" % string
            Period_repr.encoding)))).

Record t := {
  fixed : fixed;
  parametric : parametric }.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
  conv
    (fun function_parameter =>
      let '{| fixed := fixed; parametric := parametric |} := function_parameter
        in
      (fixed, parametric))
    (fun function_parameter =>
      let '(fixed, parametric) := function_parameter in
      {| fixed := fixed; parametric := parametric |}) None
    (merge_objs fixed_encoding parametric_encoding).
constants_services.ml 30 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

let custom_root =
  ( RPC_path.(open_root / "context" / "constants")
    : RPC_context.t RPC_path.context )

module S = struct
  open Data_encoding

  let errors =
    RPC_service.get_service
      ~description:"Schema for all the RPC errors from this protocol version"
      ~query:RPC_query.empty
      ~output:json_schema
      RPC_path.(custom_root / "errors")

  let all =
    RPC_service.get_service
      ~description:"All constants"
      ~query:RPC_query.empty
      ~output:Alpha_context.Constants.encoding
      custom_root
end

let register () =
  let open Services_registration in
  register0_noctxt S.errors (fun () () ->
      return Data_encoding.Json.(schema error_encoding)) ;
  register0 S.all (fun ctxt () () ->
      let open Constants in
      return {fixed; parametric = parametric ctxt})

let errors ctxt block = RPC_context.make_call0 S.errors ctxt block () ()

let all ctxt block = RPC_context.make_call0 S.all ctxt block () ()
constants_services_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Definition custom_root
  : Tezos_protocol_environment_alpha__Environment.RPC_path.context
    Tezos_protocol_environment_alpha__Environment.RPC_context.t :=
  op_div (op_div open_root "context" % string) "constants" % string.

Module S.
  Import Data_encoding.
  
  Definition errors
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t unit unit
      Tezos_protocol_environment_alpha__Environment.Data_encoding.json_schema :=
    RPC_service.get_service
      (Some "Schema for all the RPC errors from this protocol version" % string)
      RPC_query.empty json_schema (op_div custom_root "errors" % string).
  
  Definition all
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t unit unit
      Tezos_raw_protocol_alpha.Alpha_context.Constants.t :=
    RPC_service.get_service (Some "All constants" % string) RPC_query.empty
      Alpha_context.Constants.encoding custom_root.
End S.

Definition register (function_parameter : unit) : unit :=
  let 'tt := function_parameter in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register0_noctxt S.errors
      (fun function_parameter =>
        let 'tt := function_parameter in
        fun function_parameter =>
          let 'tt := function_parameter in
          __return (schema None error_encoding)) in
  register0 S.all
    (fun ctxt =>
      fun function_parameter =>
        let 'tt := function_parameter in
        fun function_parameter =>
          let 'tt := function_parameter in
          __return {| fixed := fixed; parametric := parametric ctxt |}).

Definition errors {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_protocol_environment_alpha__Environment.Data_encoding.json_schema) :=
  RPC_context.make_call0 S.errors ctxt block tt tt.

Definition all {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Constants.t) :=
  RPC_context.make_call0 S.all ctxt block tt tt.
constants_services.mli 39 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

val errors :
  'a #RPC_context.simple ->
  'a ->
  Data_encoding.json_schema shell_tzresult Lwt.t

(** Returns all the constants of the protocol *)
val all : 'a #RPC_context.simple -> 'a -> Constants.t shell_tzresult Lwt.t

val register : unit -> unit
constants_services_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter errors : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.Data_encoding.json_schema).

Parameter all : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_raw_protocol_alpha.Alpha_context.Constants.t).

Parameter register : unit -> unit.
constants_storage.ml 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

let preserved_cycles c =
  let constants = Raw_context.constants c in
  constants.preserved_cycles

let blocks_per_cycle c =
  let constants = Raw_context.constants c in
  constants.blocks_per_cycle

let blocks_per_commitment c =
  let constants = Raw_context.constants c in
  constants.blocks_per_commitment

let blocks_per_roll_snapshot c =
  let constants = Raw_context.constants c in
  constants.blocks_per_roll_snapshot

let blocks_per_voting_period c =
  let constants = Raw_context.constants c in
  constants.blocks_per_voting_period

let time_between_blocks c =
  let constants = Raw_context.constants c in
  constants.time_between_blocks

let endorsers_per_block c =
  let constants = Raw_context.constants c in
  constants.endorsers_per_block

let initial_endorsers c =
  let constants = Raw_context.constants c in
  constants.initial_endorsers

let delay_per_missing_endorsement c =
  let constants = Raw_context.constants c in
  constants.delay_per_missing_endorsement

let hard_gas_limit_per_operation c =
  let constants = Raw_context.constants c in
  constants.hard_gas_limit_per_operation

let hard_gas_limit_per_block c =
  let constants = Raw_context.constants c in
  constants.hard_gas_limit_per_block

let cost_per_byte c =
  let constants = Raw_context.constants c in
  constants.cost_per_byte

let hard_storage_limit_per_operation c =
  let constants = Raw_context.constants c in
  constants.hard_storage_limit_per_operation

let proof_of_work_threshold c =
  let constants = Raw_context.constants c in
  constants.proof_of_work_threshold

let tokens_per_roll c =
  let constants = Raw_context.constants c in
  constants.tokens_per_roll

let michelson_maximum_type_size c =
  let constants = Raw_context.constants c in
  constants.michelson_maximum_type_size

let seed_nonce_revelation_tip c =
  let constants = Raw_context.constants c in
  constants.seed_nonce_revelation_tip

let origination_size c =
  let constants = Raw_context.constants c in
  constants.origination_size

let block_security_deposit c =
  let constants = Raw_context.constants c in
  constants.block_security_deposit

let endorsement_security_deposit c =
  let constants = Raw_context.constants c in
  constants.endorsement_security_deposit

let block_reward c =
  let constants = Raw_context.constants c in
  constants.block_reward

let endorsement_reward c =
  let constants = Raw_context.constants c in
  constants.endorsement_reward

let test_chain_duration c =
  let constants = Raw_context.constants c in
  constants.test_chain_duration

let quorum_min c =
  let constants = Raw_context.constants c in
  constants.quorum_min

let quorum_max c =
  let constants = Raw_context.constants c in
  constants.quorum_max

let min_proposal_quorum c =
  let constants = Raw_context.constants c in
  constants.min_proposal_quorum

let parametric c = Raw_context.constants c
constants_storage_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition preserved_cycles (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Z :=
  let constants := Raw_context.constants c in
  preserved_cycles constants.

Definition blocks_per_cycle (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : int32 :=
  let constants := Raw_context.constants c in
  blocks_per_cycle constants.

Definition blocks_per_commitment
  (c : Tezos_raw_protocol_alpha.Raw_context.context) : int32 :=
  let constants := Raw_context.constants c in
  blocks_per_commitment constants.

Definition blocks_per_roll_snapshot
  (c : Tezos_raw_protocol_alpha.Raw_context.context) : int32 :=
  let constants := Raw_context.constants c in
  blocks_per_roll_snapshot constants.

Definition blocks_per_voting_period
  (c : Tezos_raw_protocol_alpha.Raw_context.context) : int32 :=
  let constants := Raw_context.constants c in
  blocks_per_voting_period constants.

Definition time_between_blocks
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : list Tezos_raw_protocol_alpha.Period_repr.t :=
  let constants := Raw_context.constants c in
  time_between_blocks constants.

Definition endorsers_per_block
  (c : Tezos_raw_protocol_alpha.Raw_context.context) : Z :=
  let constants := Raw_context.constants c in
  endorsers_per_block constants.

Definition initial_endorsers (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Z :=
  let constants := Raw_context.constants c in
  initial_endorsers constants.

Definition delay_per_missing_endorsement
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Period_repr.t :=
  let constants := Raw_context.constants c in
  delay_per_missing_endorsement constants.

Definition hard_gas_limit_per_operation
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_protocol_environment_alpha__Environment.Z.t :=
  let constants := Raw_context.constants c in
  hard_gas_limit_per_operation constants.

Definition hard_gas_limit_per_block
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_protocol_environment_alpha__Environment.Z.t :=
  let constants := Raw_context.constants c in
  hard_gas_limit_per_block constants.

Definition cost_per_byte (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Tez_repr.t :=
  let constants := Raw_context.constants c in
  cost_per_byte constants.

Definition hard_storage_limit_per_operation
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_protocol_environment_alpha__Environment.Z.t :=
  let constants := Raw_context.constants c in
  hard_storage_limit_per_operation constants.

Definition proof_of_work_threshold
  (c : Tezos_raw_protocol_alpha.Raw_context.context) : int64 :=
  let constants := Raw_context.constants c in
  proof_of_work_threshold constants.

Definition tokens_per_roll (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Tez_repr.t :=
  let constants := Raw_context.constants c in
  tokens_per_roll constants.

Definition michelson_maximum_type_size
  (c : Tezos_raw_protocol_alpha.Raw_context.context) : Z :=
  let constants := Raw_context.constants c in
  michelson_maximum_type_size constants.

Definition seed_nonce_revelation_tip
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Tez_repr.t :=
  let constants := Raw_context.constants c in
  seed_nonce_revelation_tip constants.

Definition origination_size (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Z :=
  let constants := Raw_context.constants c in
  origination_size constants.

Definition block_security_deposit
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Tez_repr.t :=
  let constants := Raw_context.constants c in
  block_security_deposit constants.

Definition endorsement_security_deposit
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Tez_repr.t :=
  let constants := Raw_context.constants c in
  endorsement_security_deposit constants.

Definition block_reward (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Tez_repr.t :=
  let constants := Raw_context.constants c in
  block_reward constants.

Definition endorsement_reward (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Tez_repr.t :=
  let constants := Raw_context.constants c in
  endorsement_reward constants.

Definition test_chain_duration
  (c : Tezos_raw_protocol_alpha.Raw_context.context) : int64 :=
  let constants := Raw_context.constants c in
  test_chain_duration constants.

Definition quorum_min (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : int32 :=
  let constants := Raw_context.constants c in
  quorum_min constants.

Definition quorum_max (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : int32 :=
  let constants := Raw_context.constants c in
  quorum_max constants.

Definition min_proposal_quorum
  (c : Tezos_raw_protocol_alpha.Raw_context.context) : int32 :=
  let constants := Raw_context.constants c in
  min_proposal_quorum constants.

Definition parametric (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Constants_repr.parametric :=
  Raw_context.constants c.
contract_hash.ml 3 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* 20 *)
let contract_hash = "\002\090\121" (* KT1(36) *)

include Blake2B.Make
          (Base58)
          (struct
            let name = "Contract_hash"

            let title = "A contract ID"

            let b58check_prefix = contract_hash

            let size = Some 20
          end)

let () = Base58.check_encoded_prefix b58check_encoding "KT1" 36
contract_hash_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition contract_hash : string := "Zy" % string.

(* ❌ Cannot include this kind of module expression *)
include

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute Base58.check_encoded_prefix b58check_encoding "KT1" % string 36.
contract_repr.ml 39 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t =
  | Implicit of Signature.Public_key_hash.t
  | Originated of Contract_hash.t

include Compare.Make (struct
  type nonrec t = t

  let compare l1 l2 =
    match (l1, l2) with
    | (Implicit pkh1, Implicit pkh2) ->
        Signature.Public_key_hash.compare pkh1 pkh2
    | (Originated h1, Originated h2) ->
        Contract_hash.compare h1 h2
    | (Implicit _, Originated _) ->
        -1
    | (Originated _, Implicit _) ->
        1
end)

type contract = t

type error += Invalid_contract_notation of string (* `Permanent *)

let to_b58check = function
  | Implicit pbk ->
      Signature.Public_key_hash.to_b58check pbk
  | Originated h ->
      Contract_hash.to_b58check h

let of_b58check s =
  match Base58.decode s with
  | Some (Ed25519.Public_key_hash.Data h) ->
      ok (Implicit (Signature.Ed25519 h))
  | Some (Secp256k1.Public_key_hash.Data h) ->
      ok (Implicit (Signature.Secp256k1 h))
  | Some (P256.Public_key_hash.Data h) ->
      ok (Implicit (Signature.P256 h))
  | Some (Contract_hash.Data h) ->
      ok (Originated h)
  | _ ->
      error (Invalid_contract_notation s)

let pp ppf = function
  | Implicit pbk ->
      Signature.Public_key_hash.pp ppf pbk
  | Originated h ->
      Contract_hash.pp ppf h

let pp_short ppf = function
  | Implicit pbk ->
      Signature.Public_key_hash.pp_short ppf pbk
  | Originated h ->
      Contract_hash.pp_short ppf h

let encoding =
  let open Data_encoding in
  def
    "contract_id"
    ~title:"A contract handle"
    ~description:
      "A contract notation as given to an RPC or inside scripts. Can be a \
       base58 implicit contract hash or a base58 originated contract hash."
  @@ splitted
       ~binary:
         (union
            ~tag_size:`Uint8
            [ case
                (Tag 0)
                ~title:"Implicit"
                Signature.Public_key_hash.encoding
                (function Implicit k -> Some k | _ -> None)
                (fun k -> Implicit k);
              case
                (Tag 1)
                (Fixed.add_padding Contract_hash.encoding 1)
                ~title:"Originated"
                (function Originated k -> Some k | _ -> None)
                (fun k -> Originated k) ])
       ~json:
         (conv
            to_b58check
            (fun s ->
              match of_b58check s with
              | Ok s ->
                  s
              | Error _ ->
                  Json.cannot_destruct "Invalid contract notation.")
            string)

let () =
  let open Data_encoding in
  register_error_kind
    `Permanent
    ~id:"contract.invalid_contract_notation"
    ~title:"Invalid contract notation"
    ~pp:(fun ppf x -> Format.fprintf ppf "Invalid contract notation %S" x)
    ~description:
      "A malformed contract notation was given to an RPC or in a script."
    (obj1 (req "notation" string))
    (function Invalid_contract_notation loc -> Some loc | _ -> None)
    (fun loc -> Invalid_contract_notation loc)

let implicit_contract id = Implicit id

let is_implicit = function Implicit m -> Some m | Originated _ -> None

let is_originated = function Implicit _ -> None | Originated h -> Some h

type origination_nonce = {
  operation_hash : Operation_hash.t;
  origination_index : int32;
}

let origination_nonce_encoding =
  let open Data_encoding in
  conv
    (fun {operation_hash; origination_index} ->
      (operation_hash, origination_index))
    (fun (operation_hash, origination_index) ->
      {operation_hash; origination_index})
  @@ obj2 (req "operation" Operation_hash.encoding) (dft "index" int32 0l)

let originated_contract nonce =
  let data =
    Data_encoding.Binary.to_bytes_exn origination_nonce_encoding nonce
  in
  Originated (Contract_hash.hash_bytes [data])

let originated_contracts
    ~since:{origination_index = first; operation_hash = first_hash}
    ~until:( {origination_index = last; operation_hash = last_hash} as
           origination_nonce ) =
  assert (Operation_hash.equal first_hash last_hash) ;
  let rec contracts acc origination_index =
    if Compare.Int32.(origination_index < first) then acc
    else
      let origination_nonce = {origination_nonce with origination_index} in
      let acc = originated_contract origination_nonce :: acc in
      contracts acc (Int32.pred origination_index)
  in
  contracts [] (Int32.pred last)

let initial_origination_nonce operation_hash =
  {operation_hash; origination_index = 0l}

let incr_origination_nonce nonce =
  let origination_index = Int32.succ nonce.origination_index in
  {nonce with origination_index}

let rpc_arg =
  let construct = to_b58check in
  let destruct hash =
    match of_b58check hash with
    | Error _ ->
        Error "Cannot parse contract id"
    | Ok contract ->
        Ok contract
  in
  RPC_arg.make
    ~descr:"A contract identifier encoded in b58check."
    ~name:"contract_id"
    ~construct
    ~destruct
    ()

module Index = struct
  type t = contract

  let path_length = 7

  let to_path c l =
    let raw_key = Data_encoding.Binary.to_bytes_exn encoding c in
    let (`Hex key) = MBytes.to_hex raw_key in
    let (`Hex index_key) = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
    String.sub index_key 0 2 :: String.sub index_key 2 2
    :: String.sub index_key 4 2 :: String.sub index_key 6 2
    :: String.sub index_key 8 2 :: String.sub index_key 10 2 :: key :: l

  let of_path = function
    | []
    | [_]
    | [_; _]
    | [_; _; _]
    | [_; _; _; _]
    | [_; _; _; _; _]
    | [_; _; _; _; _; _]
    | _ :: _ :: _ :: _ :: _ :: _ :: _ :: _ :: _ ->
        None
    | [index1; index2; index3; index4; index5; index6; key] ->
        let raw_key = MBytes.of_hex (`Hex key) in
        let (`Hex index_key) = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
        assert (Compare.String.(String.sub index_key 0 2 = index1)) ;
        assert (Compare.String.(String.sub index_key 2 2 = index2)) ;
        assert (Compare.String.(String.sub index_key 4 2 = index3)) ;
        assert (Compare.String.(String.sub index_key 6 2 = index4)) ;
        assert (Compare.String.(String.sub index_key 8 2 = index5)) ;
        assert (Compare.String.(String.sub index_key 10 2 = index6)) ;
        Data_encoding.Binary.of_bytes encoding raw_key

  let rpc_arg = rpc_arg

  let encoding = encoding

  let compare = compare
end
contract_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive t : Type :=
| Implicit :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t -> t
| Originated : Tezos_raw_protocol_alpha.Contract_hash.t -> t.

(* ❌ Cannot include this kind of module expression *)
include

Definition contract := t.

(* ❌ Structure item `typext` not handled. *)
type_extension

Definition to_b58check (function_parameter : t) : string :=
  match function_parameter with
  | Implicit pbk => Signature.Public_key_hash.to_b58check pbk
  | Originated h => Contract_hash.to_b58check h
  end.

Definition of_b58check (s : string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t :=
  match Base58.decode s with
  | Some (Tezos_protocol_environment_alpha__Environment.Base58.Data h) =>
    ok
      (Implicit
        (Tezos_protocol_environment_alpha__Environment.Signature.Ed25519 h))
  | Some (Tezos_protocol_environment_alpha__Environment.Base58.Data h) =>
    ok
      (Implicit
        (Tezos_protocol_environment_alpha__Environment.Signature.Secp256k1 h))
  | Some (Tezos_protocol_environment_alpha__Environment.Base58.Data h) =>
    ok
      (Implicit (Tezos_protocol_environment_alpha__Environment.Signature.P256 h))
  | Some (Tezos_protocol_environment_alpha__Environment.Base58.Data h) =>
    ok (Originated h)
  | _ =>
    error
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_contract_notation
        s)
  end.

Definition pp
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (function_parameter : t) : unit :=
  match function_parameter with
  | Implicit pbk => Signature.Public_key_hash.pp ppf pbk
  | Originated h => Contract_hash.pp ppf h
  end.

Definition pp_short
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (function_parameter : t) : unit :=
  match function_parameter with
  | Implicit pbk => Signature.Public_key_hash.pp_short ppf pbk
  | Originated h => Contract_hash.pp_short ppf h
  end.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
  op_atat
    (def "contract_id" % string (Some "A contract handle" % string)
      (Some
        "A contract notation as given to an RPC or inside scripts. Can be a base58 implicit contract hash or a base58 originated contract hash."
          % string))
    (splitted
      (conv to_b58check
        (fun s =>
          match of_b58check s with
          | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok s => s
          | Tezos_protocol_environment_alpha__Environment.Pervasives.Error _ =>
            Json.cannot_destruct
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Invalid contract notation." % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Invalid contract notation." % string)
          end) None string)
      (union
        (Some
          (* ❌ Variants not supported *)
          variant)
        (cons
          (case "Implicit" % string None
            (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
            Signature.Public_key_hash.encoding
            (fun function_parameter =>
              match function_parameter with
              | Implicit k => Some k
              | _ => None
              end) (fun k => Implicit k))
          (cons
            (case "Originated" % string None
              (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
              (Fixed.add_padding Contract_hash.encoding 1)
              (fun function_parameter =>
                match function_parameter with
                | Originated k => Some k
                | _ => None
                end) (fun k => Originated k)) [])))).

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "contract.invalid_contract_notation" % string
    "Invalid contract notation" % string
    "A malformed contract notation was given to an RPC or in a script." % string
    (Some
      (fun ppf =>
        fun x =>
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "Invalid contract notation " % string
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Caml_string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))
              "Invalid contract notation %S" % string) x))
    (obj1 (req None None "notation" % string string))
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_contract_notation
          loc => Some loc
      | _ => None
      end)
    (fun loc =>
      Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_contract_notation
        loc).

Definition implicit_contract
  (id :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : t := Implicit id.

Definition is_implicit (function_parameter : t)
  : option
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t :=
  match function_parameter with
  | Implicit m => Some m
  | Originated _ => None
  end.

Definition is_originated (function_parameter : t)
  : option Tezos_raw_protocol_alpha.Contract_hash.t :=
  match function_parameter with
  | Implicit _ => None
  | Originated h => Some h
  end.

Record origination_nonce := {
  operation_hash :
    Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t);
  origination_index : int32 }.

Definition origination_nonce_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    origination_nonce :=
  op_atat
    (let arg :=
      conv
        (fun function_parameter =>
          let '{|
            operation_hash := operation_hash;
              origination_index := origination_index
              |} := function_parameter in
          (operation_hash, origination_index))
        (fun function_parameter =>
          let '(operation_hash, origination_index) := function_parameter in
          {| operation_hash := operation_hash;
            origination_index := origination_index |}) in
    fun eta => arg None eta)
    (obj2
      (req None None "operation" % string
        Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.encoding))
      (dft None None "index" % string int32
        (* ❌ Constant of type int32 is converted to int *)
        0)).

Definition originated_contract (nonce : origination_nonce) : t :=
  let data := Data_encoding.Binary.to_bytes_exn origination_nonce_encoding nonce
    in
  Originated (Contract_hash.hash_bytes None (cons data [])).

Definition originated_contracts (function_parameter : origination_nonce)
  : origination_nonce -> list t :=
  let '{| operation_hash := first_hash; origination_index := first |} :=
    function_parameter in
  fun function_parameter =>
    let
      '{| operation_hash := last_hash; origination_index := last |} as
        origination_nonce := function_parameter in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ :=
      (* ❌ Assert instruction is not handled. *)
      assert
        (Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.equal)
          first_hash last_hash) in
    let fix contracts
      (acc : list t) (origination_index :
      Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
      : list t :=
      if
        Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
          origination_index first then
        acc
      else
        let origination_nonce :=
          (* ❌ Record substitution not handled *)
          record_substitution in
        let acc := cons (originated_contract origination_nonce) acc in
        contracts acc (Int32.pred origination_index) in
    contracts [] (Int32.pred last).

Definition initial_origination_nonce
  (operation_hash :
    Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  : origination_nonce :=
  {| operation_hash := operation_hash;
    origination_index :=
      (* ❌ Constant of type int32 is converted to int *)
      0 |}.

Definition incr_origination_nonce (nonce : origination_nonce)
  : origination_nonce :=
  let origination_index := Int32.succ (origination_index nonce) in
  (* ❌ Record substitution not handled *)
  record_substitution.

Definition rpc_arg
  : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg t :=
  let construct := to_b58check in
  let destruct (hash : string)
    : Tezos_protocol_environment_alpha__Environment.Pervasives.result t string :=
    match of_b58check hash with
    | Tezos_protocol_environment_alpha__Environment.Pervasives.Error _ =>
      Tezos_protocol_environment_alpha__Environment.Pervasives.Error
        "Cannot parse contract id" % string
    | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok contract =>
      Tezos_protocol_environment_alpha__Environment.Pervasives.Ok contract
    end in
  RPC_arg.make (Some "A contract identifier encoded in b58check." % string)
    "contract_id" % string destruct construct tt.

Module Index.
  Definition t := contract.
  
  Definition path_length : Z := 7.
  
  Definition to_path (c : t) (l : list string) : list string :=
    let raw_key := Data_encoding.Binary.to_bytes_exn encoding c in
    let 'Hex key := MBytes.to_hex raw_key in
    let 'Hex index_key := MBytes.to_hex (Raw_hashes.blake2b raw_key) in
    cons (String.sub index_key 0 2)
      (cons (String.sub index_key 2 2)
        (cons (String.sub index_key 4 2)
          (cons (String.sub index_key 6 2)
            (cons (String.sub index_key 8 2)
              (cons (String.sub index_key 10 2) (cons key l)))))).
  
  Definition of_path
    (function_parameter :
      list
        Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
    : option t :=
    match function_parameter with
    |
      [] | cons _ [] | cons _ (cons _ []) | cons _ (cons _ (cons _ [])) |
        cons _ (cons _ (cons _ (cons _ []))) |
        cons _ (cons _ (cons _ (cons _ (cons _ [])))) |
        cons _ (cons _ (cons _ (cons _ (cons _ (cons _ []))))) |
        cons _ (cons _ (cons _ (cons _ (cons _ (cons _ (cons _ (cons _ _)))))))
      => None
    |
      cons index1
        (cons index2
          (cons index3 (cons index4 (cons index5 (cons index6 (cons key []))))))
      =>
      let raw_key :=
        MBytes.of_hex
          (* ❌ Variants not supported *)
          variant in
      let 'Hex index_key := MBytes.to_hex (Raw_hashes.blake2b raw_key) in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ :=
        (* ❌ Assert instruction is not handled. *)
        assert
          (Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
            (String.sub index_key 0 2) index1) in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ :=
        (* ❌ Assert instruction is not handled. *)
        assert
          (Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
            (String.sub index_key 2 2) index2) in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ :=
        (* ❌ Assert instruction is not handled. *)
        assert
          (Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
            (String.sub index_key 4 2) index3) in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ :=
        (* ❌ Assert instruction is not handled. *)
        assert
          (Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
            (String.sub index_key 6 2) index4) in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ :=
        (* ❌ Assert instruction is not handled. *)
        assert
          (Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
            (String.sub index_key 8 2) index5) in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ :=
        (* ❌ Assert instruction is not handled. *)
        assert
          (Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
            (String.sub index_key 10 2) index6) in
      Data_encoding.Binary.of_bytes encoding raw_key
    end.
  
  Definition rpc_arg
    : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg t := rpc_arg.
  
  Definition encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
    encoding.
  
  Definition compare : t -> t -> Z := compare.
End Index.
contract_repr.mli 5 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = private
  | Implicit of Signature.Public_key_hash.t
  | Originated of Contract_hash.t

type contract = t

include Compare.S with type t := contract

(** {2 Implicit contracts} *)

val implicit_contract : Signature.Public_key_hash.t -> contract

val is_implicit : contract -> Signature.Public_key_hash.t option

(** {2 Originated contracts} *)

(** Originated contracts handles are crafted from the hash of the
    operation that triggered their origination (and nothing else).
    As a single operation can trigger several originations, the
    corresponding handles are forged from a deterministic sequence of
    nonces, initialized with the hash of the operation. *)
type origination_nonce

val originated_contract : origination_nonce -> contract

val originated_contracts :
  since:origination_nonce -> until:origination_nonce -> contract list

val initial_origination_nonce : Operation_hash.t -> origination_nonce

val incr_origination_nonce : origination_nonce -> origination_nonce

val is_originated : contract -> Contract_hash.t option

(** {2 Human readable notation} *)

type error += Invalid_contract_notation of string (* `Permanent *)

val to_b58check : contract -> string

val of_b58check : string -> contract tzresult

val pp : Format.formatter -> contract -> unit

val pp_short : Format.formatter -> contract -> unit

(** {2 Serializers} *)

val encoding : contract Data_encoding.t

val origination_nonce_encoding : origination_nonce Data_encoding.t

val rpc_arg : contract RPC_arg.arg

module Index : Storage_description.INDEX with type t = t
contract_repr_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive t : Type :=
| Implicit :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t -> t
| Originated : Tezos_raw_protocol_alpha.Contract_hash.t -> t.

Definition contract := t.

include

Parameter implicit_contract :
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  contract.

Parameter is_implicit :
contract ->
  option
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t.

Parameter origination_nonce : Type.

Parameter originated_contract : origination_nonce -> contract.

Parameter originated_contracts :
origination_nonce -> origination_nonce -> list contract.

Parameter initial_origination_nonce :
Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
  -> origination_nonce.

Parameter incr_origination_nonce : origination_nonce -> origination_nonce.

Parameter is_originated :
contract -> option Tezos_raw_protocol_alpha.Contract_hash.t.

extensible_type

Parameter to_b58check : contract -> string.

Parameter of_b58check :
string ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult contract.

Parameter pp :
Tezos_protocol_environment_alpha__Environment.Format.formatter ->
  contract -> unit.

Parameter pp_short :
Tezos_protocol_environment_alpha__Environment.Format.formatter ->
  contract -> unit.

Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t contract.

Parameter origination_nonce_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t origination_nonce.

Parameter rpc_arg :
Tezos_protocol_environment_alpha__Environment.RPC_arg.arg contract.

unhandled_module
contract_services.ml 222 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

let custom_root =
  ( RPC_path.(open_root / "context" / "contracts")
    : RPC_context.t RPC_path.context )

let big_map_root =
  ( RPC_path.(open_root / "context" / "big_maps")
    : RPC_context.t RPC_path.context )

type info = {
  balance : Tez.t;
  delegate : public_key_hash option;
  counter : counter option;
  script : Script.t option;
}

let info_encoding =
  let open Data_encoding in
  conv
    (fun {balance; delegate; script; counter} ->
      (balance, delegate, script, counter))
    (fun (balance, delegate, script, counter) ->
      {balance; delegate; script; counter})
  @@ obj4
       (req "balance" Tez.encoding)
       (opt "delegate" Signature.Public_key_hash.encoding)
       (opt "script" Script.encoding)
       (opt "counter" n)

module S = struct
  open Data_encoding

  let balance =
    RPC_service.get_service
      ~description:"Access the balance of a contract."
      ~query:RPC_query.empty
      ~output:Tez.encoding
      RPC_path.(custom_root /: Contract.rpc_arg / "balance")

  let manager_key =
    RPC_service.get_service
      ~description:"Access the manager of a contract."
      ~query:RPC_query.empty
      ~output:(option Signature.Public_key.encoding)
      RPC_path.(custom_root /: Contract.rpc_arg / "manager_key")

  let delegate =
    RPC_service.get_service
      ~description:"Access the delegate of a contract, if any."
      ~query:RPC_query.empty
      ~output:Signature.Public_key_hash.encoding
      RPC_path.(custom_root /: Contract.rpc_arg / "delegate")

  let counter =
    RPC_service.get_service
      ~description:"Access the counter of a contract, if any."
      ~query:RPC_query.empty
      ~output:z
      RPC_path.(custom_root /: Contract.rpc_arg / "counter")

  let script =
    RPC_service.get_service
      ~description:"Access the code and data of the contract."
      ~query:RPC_query.empty
      ~output:Script.encoding
      RPC_path.(custom_root /: Contract.rpc_arg / "script")

  let storage =
    RPC_service.get_service
      ~description:"Access the data of the contract."
      ~query:RPC_query.empty
      ~output:Script.expr_encoding
      RPC_path.(custom_root /: Contract.rpc_arg / "storage")

  let entrypoint_type =
    RPC_service.get_service
      ~description:"Return the type of the given entrypoint of the contract"
      ~query:RPC_query.empty
      ~output:Script.expr_encoding
      RPC_path.(
        custom_root /: Contract.rpc_arg / "entrypoints" /: RPC_arg.string)

  let list_entrypoints =
    RPC_service.get_service
      ~description:"Return the list of entrypoints of the contract"
      ~query:RPC_query.empty
      ~output:
        (obj2
           (dft
              "unreachable"
              (Data_encoding.list
                 (obj1
                    (req
                       "path"
                       (Data_encoding.list
                          Michelson_v1_primitives.prim_encoding))))
              [])
           (req "entrypoints" (assoc Script.expr_encoding)))
      RPC_path.(custom_root /: Contract.rpc_arg / "entrypoints")

  let contract_big_map_get_opt =
    RPC_service.post_service
      ~description:
        "Access the value associated with a key in a big map of the contract \
         (deprecated)."
      ~query:RPC_query.empty
      ~input:
        (obj2
           (req "key" Script.expr_encoding)
           (req "type" Script.expr_encoding))
      ~output:(option Script.expr_encoding)
      RPC_path.(custom_root /: Contract.rpc_arg / "big_map_get")

  let big_map_get =
    RPC_service.get_service
      ~description:"Access the value associated with a key in a big map."
      ~query:RPC_query.empty
      ~output:Script.expr_encoding
      RPC_path.(big_map_root /: Big_map.rpc_arg /: Script_expr_hash.rpc_arg)

  let info =
    RPC_service.get_service
      ~description:"Access the complete status of a contract."
      ~query:RPC_query.empty
      ~output:info_encoding
      RPC_path.(custom_root /: Contract.rpc_arg)

  let list =
    RPC_service.get_service
      ~description:
        "All existing contracts (including non-empty default contracts)."
      ~query:RPC_query.empty
      ~output:(list Contract.encoding)
      custom_root
end

let register () =
  let open Services_registration in
  register0 S.list (fun ctxt () () -> Contract.list ctxt >>= return) ;
  let register_field s f =
    register1 s (fun ctxt contract () () ->
        Contract.exists ctxt contract
        >>=? function true -> f ctxt contract | false -> raise Not_found)
  in
  let register_opt_field s f =
    register_field s (fun ctxt a1 ->
        f ctxt a1 >>=? function None -> raise Not_found | Some v -> return v)
  in
  let do_big_map_get ctxt id key =
    let open Script_ir_translator in
    let ctxt = Gas.set_unlimited ctxt in
    Big_map.exists ctxt id
    >>=? fun (ctxt, types) ->
    match types with
    | None ->
        raise Not_found
    | Some (_, value_type) -> (
        Lwt.return
          (parse_ty
             ctxt
             ~legacy:true
             ~allow_big_map:false
             ~allow_operation:false
             ~allow_contract:true
             (Micheline.root value_type))
        >>=? fun (Ex_ty value_type, ctxt) ->
        Big_map.get_opt ctxt id key
        >>=? fun (_ctxt, value) ->
        match value with
        | None ->
            raise Not_found
        | Some value ->
            parse_data ctxt ~legacy:true value_type (Micheline.root value)
            >>=? fun (value, ctxt) ->
            unparse_data ctxt Readable value_type value
            >>=? fun (value, _ctxt) -> return (Micheline.strip_locations value)
        )
  in
  register_field S.balance Contract.get_balance ;
  register1 S.manager_key (fun ctxt contract () () ->
      match Contract.is_implicit contract with
      | None ->
          raise Not_found
      | Some mgr -> (
          Contract.is_manager_key_revealed ctxt mgr
          >>=? function
          | false ->
              return_none
          | true ->
              Contract.get_manager_key ctxt mgr >>=? return_some )) ;
  register_opt_field S.delegate Delegate.get ;
  register1 S.counter (fun ctxt contract () () ->
      match Contract.is_implicit contract with
      | None ->
          raise Not_found
      | Some mgr ->
          Contract.get_counter ctxt mgr) ;
  register_opt_field S.script (fun c v ->
      Contract.get_script c v >>=? fun (_, v) -> return v) ;
  register_opt_field S.storage (fun ctxt contract ->
      Contract.get_script ctxt contract
      >>=? fun (ctxt, script) ->
      match script with
      | None ->
          return_none
      | Some script ->
          let ctxt = Gas.set_unlimited ctxt in
          let open Script_ir_translator in
          parse_script ctxt ~legacy:true script
          >>=? fun (Ex_script script, ctxt) ->
          unparse_script ctxt Readable script
          >>=? fun (script, ctxt) ->
          Script.force_decode ctxt script.storage
          >>=? fun (storage, _ctxt) -> return_some storage) ;
  register2 S.entrypoint_type (fun ctxt v entrypoint () () ->
      Contract.get_script_code ctxt v
      >>=? fun (_, expr) ->
      match expr with
      | None ->
          raise Not_found
      | Some expr -> (
          let ctxt = Gas.set_unlimited ctxt in
          let legacy = true in
          let open Script_ir_translator in
          Script.force_decode ctxt expr
          >>=? fun (expr, _) ->
          Lwt.return
            ( parse_toplevel ~legacy expr
            >>? fun (arg_type, _, _, root_name) ->
            parse_ty
              ctxt
              ~legacy
              ~allow_big_map:true
              ~allow_operation:false
              ~allow_contract:true
              arg_type
            >>? fun (Ex_ty arg_type, _) ->
            Script_ir_translator.find_entrypoint ~root_name arg_type entrypoint
            )
          >>= function
          | Ok (_f, Ex_ty ty) ->
              unparse_ty ctxt ty
              >>=? fun (ty_node, _) ->
              return (Micheline.strip_locations ty_node)
          | Error _ ->
              raise Not_found )) ;
  register1 S.list_entrypoints (fun ctxt v () () ->
      Contract.get_script_code ctxt v
      >>=? fun (_, expr) ->
      match expr with
      | None ->
          raise Not_found
      | Some expr ->
          let ctxt = Gas.set_unlimited ctxt in
          let legacy = true in
          let open Script_ir_translator in
          Script.force_decode ctxt expr
          >>=? fun (expr, _) ->
          Lwt.return
            ( parse_toplevel ~legacy expr
            >>? fun (arg_type, _, _, root_name) ->
            parse_ty
              ctxt
              ~legacy
              ~allow_big_map:true
              ~allow_operation:false
              ~allow_contract:true
              arg_type
            >>? fun (Ex_ty arg_type, _) ->
            Script_ir_translator.list_entrypoints ~root_name arg_type ctxt )
          >>=? fun (unreachable_entrypoint, map) ->
          return
            ( unreachable_entrypoint,
              Entrypoints_map.fold
                (fun entry (_, ty) acc ->
                  (entry, Micheline.strip_locations ty) :: acc)
                map
                [] )) ;
  register1 S.contract_big_map_get_opt (fun ctxt contract () (key, key_type) ->
      Contract.get_script ctxt contract
      >>=? fun (ctxt, script) ->
      Lwt.return
        (Script_ir_translator.parse_packable_ty
           ctxt
           ~legacy:true
           (Micheline.root key_type))
      >>=? fun (Ex_ty key_type, ctxt) ->
      Script_ir_translator.parse_data
        ctxt
        ~legacy:true
        key_type
        (Micheline.root key)
      >>=? fun (key, ctxt) ->
      Script_ir_translator.hash_data ctxt key_type key
      >>=? fun (key, ctxt) ->
      match script with
      | None ->
          raise Not_found
      | Some script ->
          let ctxt = Gas.set_unlimited ctxt in
          let open Script_ir_translator in
          parse_script ctxt ~legacy:true script
          >>=? fun (Ex_script script, ctxt) ->
          Script_ir_translator.collect_big_maps
            ctxt
            script.storage_type
            script.storage
          >>=? fun (ids, _ctxt) ->
          let ids = Script_ir_translator.list_of_big_map_ids ids in
          let rec find = function
            | [] ->
                return_none
            | (id : Z.t) :: ids -> (
              try do_big_map_get ctxt id key >>=? return_some
              with Not_found -> find ids )
          in
          find ids) ;
  register2 S.big_map_get (fun ctxt id key () () -> do_big_map_get ctxt id key) ;
  register_field S.info (fun ctxt contract ->
      Contract.get_balance ctxt contract
      >>=? fun balance ->
      Delegate.get ctxt contract
      >>=? fun delegate ->
      ( match Contract.is_implicit contract with
      | Some manager ->
          Contract.get_counter ctxt manager
          >>=? fun counter -> return_some counter
      | None ->
          return None )
      >>=? fun counter ->
      Contract.get_script ctxt contract
      >>=? fun (ctxt, script) ->
      ( match script with
      | None ->
          return (None, ctxt)
      | Some script ->
          let ctxt = Gas.set_unlimited ctxt in
          let open Script_ir_translator in
          parse_script ctxt ~legacy:true script
          >>=? fun (Ex_script script, ctxt) ->
          unparse_script ctxt Readable script
          >>=? fun (script, ctxt) -> return (Some script, ctxt) )
      >>=? fun (script, _ctxt) -> return {balance; delegate; script; counter})

let list ctxt block = RPC_context.make_call0 S.list ctxt block () ()

let info ctxt block contract =
  RPC_context.make_call1 S.info ctxt block contract () ()

let balance ctxt block contract =
  RPC_context.make_call1 S.balance ctxt block contract () ()

let manager_key ctxt block mgr =
  RPC_context.make_call1
    S.manager_key
    ctxt
    block
    (Contract.implicit_contract mgr)
    ()
    ()

let delegate ctxt block contract =
  RPC_context.make_call1 S.delegate ctxt block contract () ()

let delegate_opt ctxt block contract =
  RPC_context.make_opt_call1 S.delegate ctxt block contract () ()

let counter ctxt block mgr =
  RPC_context.make_call1
    S.counter
    ctxt
    block
    (Contract.implicit_contract mgr)
    ()
    ()

let script ctxt block contract =
  RPC_context.make_call1 S.script ctxt block contract () ()

let script_opt ctxt block contract =
  RPC_context.make_opt_call1 S.script ctxt block contract () ()

let storage ctxt block contract =
  RPC_context.make_call1 S.storage ctxt block contract () ()

let entrypoint_type ctxt block contract entrypoint =
  RPC_context.make_call2 S.entrypoint_type ctxt block contract entrypoint () ()

let list_entrypoints ctxt block contract =
  RPC_context.make_call1 S.list_entrypoints ctxt block contract () ()

let storage_opt ctxt block contract =
  RPC_context.make_opt_call1 S.storage ctxt block contract () ()

let big_map_get ctxt block id key =
  RPC_context.make_call2 S.big_map_get ctxt block id key () ()

let contract_big_map_get_opt ctxt block contract key =
  RPC_context.make_call1 S.contract_big_map_get_opt ctxt block contract () key
contract_services_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Definition custom_root
  : Tezos_protocol_environment_alpha__Environment.RPC_path.context
    Tezos_protocol_environment_alpha__Environment.RPC_context.t :=
  op_div (op_div open_root "context" % string) "contracts" % string.

Definition big_map_root
  : Tezos_protocol_environment_alpha__Environment.RPC_path.context
    Tezos_protocol_environment_alpha__Environment.RPC_context.t :=
  op_div (op_div open_root "context" % string) "big_maps" % string.

Record info := {
  balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
  delegate : option Tezos_raw_protocol_alpha.Alpha_context.public_key_hash;
  counter : option Tezos_raw_protocol_alpha.Alpha_context.counter;
  script : option Tezos_raw_protocol_alpha.Alpha_context.Script.t }.

Definition info_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding info :=
  op_atat
    (let arg :=
      conv
        (fun function_parameter =>
          let '{|
            balance := balance;
              delegate := delegate;
              counter := counter;
              script := script
              |} := function_parameter in
          (balance, delegate, script, counter))
        (fun function_parameter =>
          let '(balance, delegate, script, counter) := function_parameter in
          {| balance := balance; delegate := delegate; counter := counter;
            script := script |}) in
    fun eta => arg None eta)
    (obj4 (req None None "balance" % string Tez.encoding)
      (opt None None "delegate" % string Signature.Public_key_hash.encoding)
      (opt None None "script" % string Script.encoding)
      (opt None None "counter" % string n)).

Module S.
  Import Data_encoding.
  
  Definition balance
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit unit
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t :=
    RPC_service.get_service (Some "Access the balance of a contract." % string)
      RPC_query.empty Tez.encoding
      (op_div (op_divcolon custom_root Contract.rpc_arg) "balance" % string).
  
  Definition manager_key
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit unit
      (option
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t) :=
    RPC_service.get_service (Some "Access the manager of a contract." % string)
      RPC_query.empty (option Signature.Public_key.encoding)
      (op_div (op_divcolon custom_root Contract.rpc_arg) "manager_key" % string).
  
  Definition delegate
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit unit
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t :=
    RPC_service.get_service
      (Some "Access the delegate of a contract, if any." % string)
      RPC_query.empty Signature.Public_key_hash.encoding
      (op_div (op_divcolon custom_root Contract.rpc_arg) "delegate" % string).
  
  Definition counter
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit unit
      Tezos_protocol_environment_alpha__Environment.Z.t :=
    RPC_service.get_service
      (Some "Access the counter of a contract, if any." % string)
      RPC_query.empty z
      (op_div (op_divcolon custom_root Contract.rpc_arg) "counter" % string).
  
  Definition script
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit unit
      Tezos_raw_protocol_alpha.Alpha_context.Script.t :=
    RPC_service.get_service
      (Some "Access the code and data of the contract." % string)
      RPC_query.empty Script.encoding
      (op_div (op_divcolon custom_root Contract.rpc_arg) "script" % string).
  
  Definition storage
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit unit
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr :=
    RPC_service.get_service (Some "Access the data of the contract." % string)
      RPC_query.empty Script.expr_encoding
      (op_div (op_divcolon custom_root Contract.rpc_arg) "storage" % string).
  
  Definition entrypoint_type
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) * string) unit
      unit Tezos_raw_protocol_alpha.Alpha_context.Script.expr :=
    RPC_service.get_service
      (Some "Return the type of the given entrypoint of the contract" % string)
      RPC_query.empty Script.expr_encoding
      (op_divcolon
        (op_div (op_divcolon custom_root Contract.rpc_arg)
          "entrypoints" % string) RPC_arg.string).
  
  Definition list_entrypoints
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit unit
      (list (list Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) *
        list (string * Tezos_raw_protocol_alpha.Alpha_context.Script.expr)) :=
    RPC_service.get_service
      (Some "Return the list of entrypoints of the contract" % string)
      RPC_query.empty
      (obj2
        (dft None None "unreachable" % string
          (Data_encoding.list None
            (obj1
              (req None None "path" % string
                (Data_encoding.list None Michelson_v1_primitives.prim_encoding))))
          [])
        (req None None "entrypoints" % string (assoc Script.expr_encoding)))
      (op_div (op_divcolon custom_root Contract.rpc_arg) "entrypoints" % string).
  
  Definition contract_big_map_get_opt
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit
      (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
        Tezos_raw_protocol_alpha.Alpha_context.Script.expr)
      (option Tezos_raw_protocol_alpha.Alpha_context.Script.expr) :=
    RPC_service.post_service
      (Some
        "Access the value associated with a key in a big map of the contract (deprecated)."
          % string) RPC_query.empty
      (obj2 (req None None "key" % string Script.expr_encoding)
        (req None None "type" % string Script.expr_encoding))
      (option Script.expr_encoding)
      (op_div (op_divcolon custom_root Contract.rpc_arg) "big_map_get" % string).
  
  Definition big_map_get
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Big_map.id) *
        Tezos_raw_protocol_alpha.Script_expr_hash.t) unit unit
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr :=
    RPC_service.get_service
      (Some "Access the value associated with a key in a big map." % string)
      RPC_query.empty Script.expr_encoding
      (op_divcolon (op_divcolon big_map_root Big_map.rpc_arg)
        Script_expr_hash.rpc_arg).
  
  Definition info
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit unit info :=
    RPC_service.get_service
      (Some "Access the complete status of a contract." % string)
      RPC_query.empty info_encoding (op_divcolon custom_root Contract.rpc_arg).
  
  Definition list
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t unit unit
      (list Tezos_raw_protocol_alpha.Alpha_context.Contract.t) :=
    RPC_service.get_service
      (Some
        "All existing contracts (including non-empty default contracts)." %
          string) RPC_query.empty (list None Contract.encoding) custom_root.
End S.

Definition register (function_parameter : unit) : unit :=
  let 'tt := function_parameter in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register0 S.list
      (fun ctxt =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteq (Contract.list ctxt) __return) in
  let register_field {A : Type}
    (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit unit A)
    (f :
    Tezos_raw_protocol_alpha.Alpha_context.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Contract.contract ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A))
    : unit :=
    register1 s
      (fun ctxt =>
        fun contract =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteqquestion (Contract.__exists ctxt contract)
                (fun function_parameter =>
                  match function_parameter with
                  | true => f ctxt contract
                  | false => raise OCaml.Not_found
                  end)) in
  let register_opt_field {A : Type}
    (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_raw_protocol_alpha.Alpha_context.Contract.contract) unit unit A)
    (f :
    Tezos_raw_protocol_alpha.Alpha_context.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Contract.contract ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (option A))) : unit :=
    register_field s
      (fun ctxt =>
        fun a1 =>
          op_gtgteqquestion (f ctxt a1)
            (fun function_parameter =>
              match function_parameter with
              | None => raise OCaml.Not_found
              | Some v => __return v
              end)) in
  let do_big_map_get
    (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context) (id :
    Tezos_raw_protocol_alpha.Alpha_context.Big_map.id) (key :
    Tezos_raw_protocol_alpha.Script_expr_hash.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_protocol_environment_alpha__Environment.Micheline.canonical
          Tezos_raw_protocol_alpha.Alpha_context.Script.prim)) :=
    let ctxt := Gas.set_unlimited ctxt in
    op_gtgteqquestion (Big_map.__exists ctxt id)
      (fun function_parameter =>
        let '(ctxt, types) := function_parameter in
        match types with
        | None => raise OCaml.Not_found
        | Some (_, value_type) =>
          op_gtgteqquestion
            (Lwt.__return
              (parse_ty ctxt true false false true (Micheline.root value_type)))
            (fun function_parameter =>
              let
                '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_ty value_type,
                  ctxt) := function_parameter in
              op_gtgteqquestion (Big_map.get_opt ctxt id key)
                (fun function_parameter =>
                  let '(_ctxt, value) := function_parameter in
                  match value with
                  | None => raise OCaml.Not_found
                  | Some value =>
                    op_gtgteqquestion
                      (parse_data None ctxt true value_type
                        (Micheline.root value))
                      (fun function_parameter =>
                        let '(value, ctxt) := function_parameter in
                        op_gtgteqquestion
                          (unparse_data ctxt
                            Tezos_raw_protocol_alpha.Script_ir_translator.Readable
                            value_type value)
                          (fun function_parameter =>
                            let '(value, _ctxt) := function_parameter in
                            __return (Micheline.strip_locations value)))
                  end))
        end) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := register_field S.balance Contract.get_balance in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.manager_key
      (fun ctxt =>
        fun contract =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              match Contract.is_implicit contract with
              | None => raise OCaml.Not_found
              | Some mgr =>
                op_gtgteqquestion (Contract.is_manager_key_revealed ctxt mgr)
                  (fun function_parameter =>
                    match function_parameter with
                    | false => return_none
                    | true =>
                      op_gtgteqquestion (Contract.get_manager_key ctxt mgr)
                        return_some
                    end)
              end) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := register_opt_field S.delegate Delegate.get in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.counter
      (fun ctxt =>
        fun contract =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              match Contract.is_implicit contract with
              | None => raise OCaml.Not_found
              | Some mgr => Contract.get_counter ctxt mgr
              end) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_opt_field S.script
      (fun c =>
        fun v =>
          op_gtgteqquestion (Contract.get_script c v)
            (fun function_parameter =>
              let '(_, v) := function_parameter in
              __return v)) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_opt_field S.storage
      (fun ctxt =>
        fun contract =>
          op_gtgteqquestion (Contract.get_script ctxt contract)
            (fun function_parameter =>
              let '(ctxt, script) := function_parameter in
              match script with
              | None => return_none
              | Some script =>
                let ctxt := Gas.set_unlimited ctxt in
                op_gtgteqquestion (parse_script None ctxt true script)
                  (fun function_parameter =>
                    let
                      '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_script
                        script, ctxt) := function_parameter in
                    op_gtgteqquestion
                      (unparse_script ctxt
                        Tezos_raw_protocol_alpha.Script_ir_translator.Readable
                        script)
                      (fun function_parameter =>
                        let '(script, ctxt) := function_parameter in
                        op_gtgteqquestion
                          (Script.force_decode ctxt (storage script))
                          (fun function_parameter =>
                            let '(storage, _ctxt) := function_parameter in
                            return_some storage)))
              end)) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register2 S.entrypoint_type
      (fun ctxt =>
        fun v =>
          fun entrypoint =>
            fun function_parameter =>
              let 'tt := function_parameter in
              fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion (Contract.get_script_code ctxt v)
                  (fun function_parameter =>
                    let '(_, expr) := function_parameter in
                    match expr with
                    | None => raise OCaml.Not_found
                    | Some expr =>
                      let ctxt := Gas.set_unlimited ctxt in
                      let legacy := true in
                      op_gtgteqquestion (Script.force_decode ctxt expr)
                        (fun function_parameter =>
                          let '(expr, _) := function_parameter in
                          op_gtgteq
                            (Lwt.__return
                              (op_gtgtquestion (parse_toplevel legacy expr)
                                (fun function_parameter =>
                                  let '(arg_type, _, _, root_name) :=
                                    function_parameter in
                                  op_gtgtquestion
                                    (parse_ty ctxt legacy true false true
                                      arg_type)
                                    (fun function_parameter =>
                                      let
                                        '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_ty
                                          arg_type, _) := function_parameter in
                                      Script_ir_translator.find_entrypoint
                                        arg_type root_name entrypoint))))
                            (fun function_parameter =>
                              match function_parameter with
                              |
                                Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                                  (_f,
                                    Tezos_raw_protocol_alpha.Script_ir_translator.Ex_ty
                                      ty) =>
                                op_gtgteqquestion (unparse_ty ctxt ty)
                                  (fun function_parameter =>
                                    let '(ty_node, _) := function_parameter in
                                    __return (Micheline.strip_locations ty_node))
                              |
                                Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                                  _ => raise OCaml.Not_found
                              end))
                    end)) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.list_entrypoints
      (fun ctxt =>
        fun v =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteqquestion (Contract.get_script_code ctxt v)
                (fun function_parameter =>
                  let '(_, expr) := function_parameter in
                  match expr with
                  | None => raise OCaml.Not_found
                  | Some expr =>
                    let ctxt := Gas.set_unlimited ctxt in
                    let legacy := true in
                    op_gtgteqquestion (Script.force_decode ctxt expr)
                      (fun function_parameter =>
                        let '(expr, _) := function_parameter in
                        op_gtgteqquestion
                          (Lwt.__return
                            (op_gtgtquestion (parse_toplevel legacy expr)
                              (fun function_parameter =>
                                let '(arg_type, _, _, root_name) :=
                                  function_parameter in
                                op_gtgtquestion
                                  (parse_ty ctxt legacy true false true arg_type)
                                  (fun function_parameter =>
                                    let
                                      '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_ty
                                        arg_type, _) := function_parameter in
                                    Script_ir_translator.list_entrypoints
                                      arg_type ctxt root_name))))
                          (fun function_parameter =>
                            let '(unreachable_entrypoint, map) :=
                              function_parameter in
                            __return
                              (unreachable_entrypoint,
                                (Entrypoints_map.fold
                                  (fun entry =>
                                    fun function_parameter =>
                                      let '(_, ty) := function_parameter in
                                      fun acc =>
                                        cons
                                          (entry, (Micheline.strip_locations ty))
                                          acc) map []))))
                  end)) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.contract_big_map_get_opt
      (fun ctxt =>
        fun contract =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let '(key, key_type) := function_parameter in
              op_gtgteqquestion (Contract.get_script ctxt contract)
                (fun function_parameter =>
                  let '(ctxt, script) := function_parameter in
                  op_gtgteqquestion
                    (Lwt.__return
                      (Script_ir_translator.parse_packable_ty ctxt true
                        (Micheline.root key_type)))
                    (fun function_parameter =>
                      let
                        '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_ty
                          key_type, ctxt) := function_parameter in
                      op_gtgteqquestion
                        (Script_ir_translator.parse_data None ctxt true key_type
                          (Micheline.root key))
                        (fun function_parameter =>
                          let '(key, ctxt) := function_parameter in
                          op_gtgteqquestion
                            (Script_ir_translator.hash_data ctxt key_type key)
                            (fun function_parameter =>
                              let '(key, ctxt) := function_parameter in
                              match script with
                              | None => raise OCaml.Not_found
                              | Some script =>
                                let ctxt := Gas.set_unlimited ctxt in
                                op_gtgteqquestion
                                  (parse_script None ctxt true script)
                                  (fun function_parameter =>
                                    let
                                      '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_script
                                        script, ctxt) := function_parameter in
                                    op_gtgteqquestion
                                      (Script_ir_translator.collect_big_maps
                                        ctxt (storage_type script)
                                        (storage script))
                                      (fun function_parameter =>
                                        let '(ids, _ctxt) := function_parameter
                                          in
                                        let ids :=
                                          Script_ir_translator.list_of_big_map_ids
                                            ids in
                                        let fix find
                                          (function_parameter :
                                          list
                                            Tezos_protocol_environment_alpha__Environment.Z.t)
                                          : Tezos_protocol_environment_alpha__Environment.Lwt.t
                                            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                                              (option
                                                (Tezos_protocol_environment_alpha__Environment.Micheline.canonical
                                                  Tezos_raw_protocol_alpha.Alpha_context.Script.prim))) :=
                                          match function_parameter with
                                          | [] => return_none
                                          | cons (_ as id) ids =>
                                            (* ❌ Try-with are not handled *)
                                            try
                                              (op_gtgteqquestion
                                                (do_big_map_get ctxt id key)
                                                return_some)
                                          end in
                                        find ids))
                              end))))) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register2 S.big_map_get
      (fun ctxt =>
        fun id =>
          fun key =>
            fun function_parameter =>
              let 'tt := function_parameter in
              fun function_parameter =>
                let 'tt := function_parameter in
                do_big_map_get ctxt id key) in
  register_field S.info
    (fun ctxt =>
      fun contract =>
        op_gtgteqquestion (Contract.get_balance ctxt contract)
          (fun balance =>
            op_gtgteqquestion (Delegate.get ctxt contract)
              (fun delegate =>
                op_gtgteqquestion
                  match Contract.is_implicit contract with
                  | Some manager =>
                    op_gtgteqquestion (Contract.get_counter ctxt manager)
                      (fun counter => return_some counter)
                  | None => __return None
                  end
                  (fun counter =>
                    op_gtgteqquestion (Contract.get_script ctxt contract)
                      (fun function_parameter =>
                        let '(ctxt, script) := function_parameter in
                        op_gtgteqquestion
                          match script with
                          | None => __return (None, ctxt)
                          | Some script =>
                            let ctxt := Gas.set_unlimited ctxt in
                            op_gtgteqquestion
                              (parse_script None ctxt true script)
                              (fun function_parameter =>
                                let
                                  '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_script
                                    script, ctxt) := function_parameter in
                                op_gtgteqquestion
                                  (unparse_script ctxt
                                    Tezos_raw_protocol_alpha.Script_ir_translator.Readable
                                    script)
                                  (fun function_parameter =>
                                    let '(script, ctxt) := function_parameter in
                                    __return ((Some script), ctxt)))
                          end
                          (fun function_parameter =>
                            let '(script, _ctxt) := function_parameter in
                            __return
                              {| balance := balance; delegate := delegate;
                                counter := counter; script := script |})))))).

Definition list {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (list Tezos_raw_protocol_alpha.Alpha_context.Contract.t)) :=
  RPC_context.make_call0 S.list ctxt block tt tt.

Definition info {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      info) := RPC_context.make_call1 S.info ctxt block contract tt tt.

Definition balance {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t) :=
  RPC_context.make_call1 S.balance ctxt block contract tt tt.

Definition manager_key {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D) (mgr : Tezos_raw_protocol_alpha__Alpha_context.public_key_hash)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (option
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)) :=
  RPC_context.make_call1 S.manager_key ctxt block
    (Contract.implicit_contract mgr) tt tt.

Definition delegate {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t) :=
  RPC_context.make_call1 S.delegate ctxt block contract tt tt.

Definition delegate_opt {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (option
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)) :=
  RPC_context.make_opt_call1 S.delegate ctxt block contract tt tt.

Definition counter {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D) (mgr : Tezos_raw_protocol_alpha__Alpha_context.public_key_hash)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_protocol_environment_alpha__Environment.Z.t) :=
  RPC_context.make_call1 S.counter ctxt block (Contract.implicit_contract mgr)
    tt tt.

Definition script {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Script.t) :=
  RPC_context.make_call1 S.script ctxt block contract tt tt.

Definition script_opt {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (option Tezos_raw_protocol_alpha.Alpha_context.Script.t)) :=
  RPC_context.make_opt_call1 S.script ctxt block contract tt tt.

Definition storage {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr) :=
  RPC_context.make_call1 S.storage ctxt block contract tt tt.

Definition entrypoint_type {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  (entrypoint : string)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr) :=
  RPC_context.make_call2 S.entrypoint_type ctxt block contract entrypoint tt tt.

Definition list_entrypoints {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (list (list Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) *
        list (string * Tezos_raw_protocol_alpha.Alpha_context.Script.expr))) :=
  RPC_context.make_call1 S.list_entrypoints ctxt block contract tt tt.

Definition storage_opt {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (option Tezos_raw_protocol_alpha.Alpha_context.Script.expr)) :=
  RPC_context.make_opt_call1 S.storage ctxt block contract tt tt.

Definition big_map_get {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D) (id : Tezos_raw_protocol_alpha.Alpha_context.Big_map.id)
  (key : Tezos_raw_protocol_alpha.Script_expr_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr) :=
  RPC_context.make_call2 S.big_map_get ctxt block id key tt tt.

Definition contract_big_map_get_opt {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
  (key :
    Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (option Tezos_raw_protocol_alpha.Alpha_context.Script.expr)) :=
  RPC_context.make_call1 S.contract_big_map_get_opt ctxt block contract tt key.
contract_services.mli 286 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

val list : 'a #RPC_context.simple -> 'a -> Contract.t list shell_tzresult Lwt.t

type info = {
  balance : Tez.t;
  delegate : public_key_hash option;
  counter : counter option;
  script : Script.t option;
}

val info_encoding : info Data_encoding.t

val info :
  'a #RPC_context.simple -> 'a -> Contract.t -> info shell_tzresult Lwt.t

val balance :
  'a #RPC_context.simple -> 'a -> Contract.t -> Tez.t shell_tzresult Lwt.t

val manager_key :
  'a #RPC_context.simple ->
  'a ->
  public_key_hash ->
  public_key option shell_tzresult Lwt.t

val delegate :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  public_key_hash shell_tzresult Lwt.t

val delegate_opt :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  public_key_hash option shell_tzresult Lwt.t

val counter :
  'a #RPC_context.simple ->
  'a ->
  public_key_hash ->
  counter shell_tzresult Lwt.t

val script :
  'a #RPC_context.simple -> 'a -> Contract.t -> Script.t shell_tzresult Lwt.t

val script_opt :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  Script.t option shell_tzresult Lwt.t

val storage :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  Script.expr shell_tzresult Lwt.t

val entrypoint_type :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  string ->
  Script.expr shell_tzresult Lwt.t

val list_entrypoints :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  (Michelson_v1_primitives.prim list list * (string * Script.expr) list)
  shell_tzresult
  Lwt.t

val storage_opt :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  Script.expr option shell_tzresult Lwt.t

val big_map_get :
  'a #RPC_context.simple ->
  'a ->
  Z.t ->
  Script_expr_hash.t ->
  Script.expr shell_tzresult Lwt.t

val contract_big_map_get_opt :
  'a #RPC_context.simple ->
  'a ->
  Contract.t ->
  Script.expr * Script.expr ->
  Script.expr option shell_tzresult Lwt.t

val register : unit -> unit
contract_services_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter list : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (list Tezos_raw_protocol_alpha.Alpha_context.Contract.t)).

Record info := {
  balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
  delegate : option Tezos_raw_protocol_alpha.Alpha_context.public_key_hash;
  counter : option Tezos_raw_protocol_alpha.Alpha_context.counter;
  script : option Tezos_raw_protocol_alpha.Alpha_context.Script.t }.

Parameter info_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t info.

Parameter info : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          info).

Parameter balance : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          Tezos_raw_protocol_alpha.Alpha_context.Tez.t).

Parameter manager_key : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          (option Tezos_raw_protocol_alpha.Alpha_context.public_key)).

Parameter delegate : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          Tezos_raw_protocol_alpha.Alpha_context.public_key_hash).

Parameter delegate_opt : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          (option Tezos_raw_protocol_alpha.Alpha_context.public_key_hash)).

Parameter counter : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          Tezos_raw_protocol_alpha.Alpha_context.counter).

Parameter script : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          Tezos_raw_protocol_alpha.Alpha_context.Script.t).

Parameter script_opt : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          (option Tezos_raw_protocol_alpha.Alpha_context.Script.t)).

Parameter storage : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr).

Parameter entrypoint_type : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
      string ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            Tezos_raw_protocol_alpha.Alpha_context.Script.expr).

Parameter list_entrypoints : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          (list (list Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) *
            list (string * Tezos_raw_protocol_alpha.Alpha_context.Script.expr))).

Parameter storage_opt : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          (option Tezos_raw_protocol_alpha.Alpha_context.Script.expr)).

Parameter big_map_get : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_raw_protocol_alpha.Script_expr_hash.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            Tezos_raw_protocol_alpha.Alpha_context.Script.expr).

Parameter contract_big_map_get_opt : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
        Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            (option Tezos_raw_protocol_alpha.Alpha_context.Script.expr)).

Parameter register : unit -> unit.
contract_storage.ml 43 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type error +=
  | Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t
  | (* `Temporary *)
      Counter_in_the_past of Contract_repr.contract * Z.t * Z.t
  | (* `Branch *)
      Counter_in_the_future of Contract_repr.contract * Z.t * Z.t
  | (* `Temporary *)
      Unspendable_contract of Contract_repr.contract
  | (* `Permanent *)
      Non_existing_contract of Contract_repr.contract
  | (* `Temporary *)
      Empty_implicit_contract of Signature.Public_key_hash.t
  | (* `Temporary *)
      Empty_transaction of Contract_repr.t (* `Temporary *)
  | Inconsistent_hash of
      Signature.Public_key.t
      * Signature.Public_key_hash.t
      * Signature.Public_key_hash.t
  | (* `Permanent *)
      Inconsistent_public_key of
      Signature.Public_key.t * Signature.Public_key.t
  | (* `Permanent *)
      Failure of string (* `Permanent *)
  | Previously_revealed_key of Contract_repr.t (* `Permanent *)
  | Unrevealed_manager_key of Contract_repr.t

(* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"contract.unspendable_contract"
    ~title:"Unspendable contract"
    ~description:
      "An operation tried to spend tokens from an unspendable contract"
    ~pp:(fun ppf c ->
      Format.fprintf
        ppf
        "The tokens of contract %a can only be spent by its script"
        Contract_repr.pp
        c)
    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
    (function Unspendable_contract c -> Some c | _ -> None)
    (fun c -> Unspendable_contract c) ;
  register_error_kind
    `Temporary
    ~id:"contract.balance_too_low"
    ~title:"Balance too low"
    ~description:
      "An operation tried to spend more tokens than the contract has"
    ~pp:(fun ppf (c, b, a) ->
      Format.fprintf
        ppf
        "Balance of contract %a too low (%a) to spend %a"
        Contract_repr.pp
        c
        Tez_repr.pp
        b
        Tez_repr.pp
        a)
    Data_encoding.(
      obj3
        (req "contract" Contract_repr.encoding)
        (req "balance" Tez_repr.encoding)
        (req "amount" Tez_repr.encoding))
    (function Balance_too_low (c, b, a) -> Some (c, b, a) | _ -> None)
    (fun (c, b, a) -> Balance_too_low (c, b, a)) ;
  register_error_kind
    `Temporary
    ~id:"contract.counter_in_the_future"
    ~title:"Invalid counter (not yet reached) in a manager operation"
    ~description:"An operation assumed a contract counter in the future"
    ~pp:(fun ppf (contract, exp, found) ->
      Format.fprintf
        ppf
        "Counter %s not yet reached for contract %a (expected %s)"
        (Z.to_string found)
        Contract_repr.pp
        contract
        (Z.to_string exp))
    Data_encoding.(
      obj3
        (req "contract" Contract_repr.encoding)
        (req "expected" z)
        (req "found" z))
    (function Counter_in_the_future (c, x, y) -> Some (c, x, y) | _ -> None)
    (fun (c, x, y) -> Counter_in_the_future (c, x, y)) ;
  register_error_kind
    `Branch
    ~id:"contract.counter_in_the_past"
    ~title:"Invalid counter (already used) in a manager operation"
    ~description:"An operation assumed a contract counter in the past"
    ~pp:(fun ppf (contract, exp, found) ->
      Format.fprintf
        ppf
        "Counter %s already used for contract %a (expected %s)"
        (Z.to_string found)
        Contract_repr.pp
        contract
        (Z.to_string exp))
    Data_encoding.(
      obj3
        (req "contract" Contract_repr.encoding)
        (req "expected" z)
        (req "found" z))
    (function Counter_in_the_past (c, x, y) -> Some (c, x, y) | _ -> None)
    (fun (c, x, y) -> Counter_in_the_past (c, x, y)) ;
  register_error_kind
    `Temporary
    ~id:"contract.non_existing_contract"
    ~title:"Non existing contract"
    ~description:
      "A contract handle is not present in the context (either it never was \
       or it has been destroyed)"
    ~pp:(fun ppf contract ->
      Format.fprintf ppf "Contract %a does not exist" Contract_repr.pp contract)
    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
    (function Non_existing_contract c -> Some c | _ -> None)
    (fun c -> Non_existing_contract c) ;
  register_error_kind
    `Permanent
    ~id:"contract.manager.inconsistent_hash"
    ~title:"Inconsistent public key hash"
    ~description:
      "A revealed manager public key is inconsistent with the announced hash"
    ~pp:(fun ppf (k, eh, ph) ->
      Format.fprintf
        ppf
        "The hash of the manager public key %s is not %a as announced but %a"
        (Signature.Public_key.to_b58check k)
        Signature.Public_key_hash.pp
        ph
        Signature.Public_key_hash.pp
        eh)
    Data_encoding.(
      obj3
        (req "public_key" Signature.Public_key.encoding)
        (req "expected_hash" Signature.Public_key_hash.encoding)
        (req "provided_hash" Signature.Public_key_hash.encoding))
    (function Inconsistent_hash (k, eh, ph) -> Some (k, eh, ph) | _ -> None)
    (fun (k, eh, ph) -> Inconsistent_hash (k, eh, ph)) ;
  register_error_kind
    `Permanent
    ~id:"contract.manager.inconsistent_public_key"
    ~title:"Inconsistent public key"
    ~description:
      "A provided manager public key is different with the public key stored \
       in the contract"
    ~pp:(fun ppf (eh, ph) ->
      Format.fprintf
        ppf
        "Expected manager public key %s but %s was provided"
        (Signature.Public_key.to_b58check ph)
        (Signature.Public_key.to_b58check eh))
    Data_encoding.(
      obj2
        (req "public_key" Signature.Public_key.encoding)
        (req "expected_public_key" Signature.Public_key.encoding))
    (function Inconsistent_public_key (eh, ph) -> Some (eh, ph) | _ -> None)
    (fun (eh, ph) -> Inconsistent_public_key (eh, ph)) ;
  register_error_kind
    `Permanent
    ~id:"contract.failure"
    ~title:"Contract storage failure"
    ~description:"Unexpected contract storage error"
    ~pp:(fun ppf s -> Format.fprintf ppf "Contract_storage.Failure %S" s)
    Data_encoding.(obj1 (req "message" string))
    (function Failure s -> Some s | _ -> None)
    (fun s -> Failure s) ;
  register_error_kind
    `Branch
    ~id:"contract.unrevealed_key"
    ~title:"Manager operation precedes key revelation"
    ~description:
      "One tried to apply a manager operation without revealing the manager \
       public key"
    ~pp:(fun ppf s ->
      Format.fprintf
        ppf
        "Unrevealed manager key for contract %a."
        Contract_repr.pp
        s)
    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
    (function Unrevealed_manager_key s -> Some s | _ -> None)
    (fun s -> Unrevealed_manager_key s) ;
  register_error_kind
    `Branch
    ~id:"contract.previously_revealed_key"
    ~title:"Manager operation already revealed"
    ~description:"One tried to revealed twice a manager public key"
    ~pp:(fun ppf s ->
      Format.fprintf
        ppf
        "Previously revealed manager key for contract %a."
        Contract_repr.pp
        s)
    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
    (function Previously_revealed_key s -> Some s | _ -> None)
    (fun s -> Previously_revealed_key s) ;
  register_error_kind
    `Branch
    ~id:"implicit.empty_implicit_contract"
    ~title:"Empty implicit contract"
    ~description:
      "No manager operations are allowed on an empty implicit contract."
    ~pp:(fun ppf implicit ->
      Format.fprintf
        ppf
        "Empty implicit contract (%a)"
        Signature.Public_key_hash.pp
        implicit)
    Data_encoding.(obj1 (req "implicit" Signature.Public_key_hash.encoding))
    (function Empty_implicit_contract c -> Some c | _ -> None)
    (fun c -> Empty_implicit_contract c) ;
  register_error_kind
    `Branch
    ~id:"contract.empty_transaction"
    ~title:"Empty transaction"
    ~description:"Forbidden to credit 0ꜩ to a contract without code."
    ~pp:(fun ppf contract ->
      Format.fprintf
        ppf
        "Transaction of 0ꜩ towards a contract without code are forbidden \
         (%a)."
        Contract_repr.pp
        contract)
    Data_encoding.(obj1 (req "contract" Contract_repr.encoding))
    (function Empty_transaction c -> Some c | _ -> None)
    (fun c -> Empty_transaction c)

let failwith msg = fail (Failure msg)

type big_map_diff_item =
  | Update of {
      big_map : Z.t;
      diff_key : Script_repr.expr;
      diff_key_hash : Script_expr_hash.t;
      diff_value : Script_repr.expr option;
    }
  | Clear of Z.t
  | Copy of Z.t * Z.t
  | Alloc of {
      big_map : Z.t;
      key_type : Script_repr.expr;
      value_type : Script_repr.expr;
    }

type big_map_diff = big_map_diff_item list

let big_map_diff_item_encoding =
  let open Data_encoding in
  union
    [ case
        (Tag 0)
        ~title:"update"
        (obj5
           (req "action" (constant "update"))
           (req "big_map" z)
           (req "key_hash" Script_expr_hash.encoding)
           (req "key" Script_repr.expr_encoding)
           (opt "value" Script_repr.expr_encoding))
        (function
          | Update {big_map; diff_key_hash; diff_key; diff_value} ->
              Some ((), big_map, diff_key_hash, diff_key, diff_value)
          | _ ->
              None)
        (fun ((), big_map, diff_key_hash, diff_key, diff_value) ->
          Update {big_map; diff_key_hash; diff_key; diff_value});
      case
        (Tag 1)
        ~title:"remove"
        (obj2 (req "action" (constant "remove")) (req "big_map" z))
        (function Clear big_map -> Some ((), big_map) | _ -> None)
        (fun ((), big_map) -> Clear big_map);
      case
        (Tag 2)
        ~title:"copy"
        (obj3
           (req "action" (constant "copy"))
           (req "source_big_map" z)
           (req "destination_big_map" z))
        (function Copy (src, dst) -> Some ((), src, dst) | _ -> None)
        (fun ((), src, dst) -> Copy (src, dst));
      case
        (Tag 3)
        ~title:"alloc"
        (obj4
           (req "action" (constant "alloc"))
           (req "big_map" z)
           (req "key_type" Script_repr.expr_encoding)
           (req "value_type" Script_repr.expr_encoding))
        (function
          | Alloc {big_map; key_type; value_type} ->
              Some ((), big_map, key_type, value_type)
          | _ ->
              None)
        (fun ((), big_map, key_type, value_type) ->
          Alloc {big_map; key_type; value_type}) ]

let big_map_diff_encoding =
  let open Data_encoding in
  def "contract.big_map_diff" @@ list big_map_diff_item_encoding

let big_map_key_cost = 65

let big_map_cost = 33

let update_script_big_map c = function
  | None ->
      return (c, Z.zero)
  | Some diff ->
      fold_left_s
        (fun (c, total) -> function Clear id ->
              Storage.Big_map.Total_bytes.get c id
              >>=? fun size ->
              Storage.Big_map.remove_rec c id
              >>= fun c ->
              if Compare.Z.(id < Z.zero) then return (c, total)
              else return (c, Z.sub (Z.sub total size) (Z.of_int big_map_cost))
          | Copy (from, to_) ->
              Storage.Big_map.copy c ~from ~to_
              >>=? fun c ->
              if Compare.Z.(to_ < Z.zero) then return (c, total)
              else
                Storage.Big_map.Total_bytes.get c from
                >>=? fun size ->
                return (c, Z.add (Z.add total size) (Z.of_int big_map_cost))
          | Alloc {big_map; key_type; value_type} ->
              Storage.Big_map.Total_bytes.init c big_map Z.zero
              >>=? fun c ->
              (* Annotations are erased to allow sharing on
                 [Copy]. The types from the contract code are used,
                 these ones are only used to make sure they are
                 compatible during transmissions between contracts,
                 and only need to be compatible, annotations
                 nonwhistanding. *)
              let key_type =
                Micheline.strip_locations
                  (Script_repr.strip_annotations (Micheline.root key_type))
              in
              let value_type =
                Micheline.strip_locations
                  (Script_repr.strip_annotations (Micheline.root value_type))
              in
              Storage.Big_map.Key_type.init c big_map key_type
              >>=? fun c ->
              Storage.Big_map.Value_type.init c big_map value_type
              >>=? fun c ->
              if Compare.Z.(big_map < Z.zero) then return (c, total)
              else return (c, Z.add total (Z.of_int big_map_cost))
          | Update {big_map; diff_key_hash; diff_value = None} ->
              Storage.Big_map.Contents.remove (c, big_map) diff_key_hash
              >>=? fun (c, freed, existed) ->
              let freed =
                if existed then freed + big_map_key_cost else freed
              in
              Storage.Big_map.Total_bytes.get c big_map
              >>=? fun size ->
              Storage.Big_map.Total_bytes.set
                c
                big_map
                (Z.sub size (Z.of_int freed))
              >>=? fun c ->
              if Compare.Z.(big_map < Z.zero) then return (c, total)
              else return (c, Z.sub total (Z.of_int freed))
          | Update {big_map; diff_key_hash; diff_value = Some v} ->
              Storage.Big_map.Contents.init_set (c, big_map) diff_key_hash v
              >>=? fun (c, size_diff, existed) ->
              let size_diff =
                if existed then size_diff else size_diff + big_map_key_cost
              in
              Storage.Big_map.Total_bytes.get c big_map
              >>=? fun size ->
              Storage.Big_map.Total_bytes.set
                c
                big_map
                (Z.add size (Z.of_int size_diff))
              >>=? fun c ->
              if Compare.Z.(big_map < Z.zero) then return (c, total)
              else return (c, Z.add total (Z.of_int size_diff)))
        (c, Z.zero)
        diff

let create_base c ?(prepaid_bootstrap_storage = false)
    (* Free space for bootstrap contracts *)
    contract ~balance ~manager ~delegate ?script () =
  ( match Contract_repr.is_implicit contract with
  | None ->
      return c
  | Some _ ->
      Storage.Contract.Global_counter.get c
      >>=? fun counter -> Storage.Contract.Counter.init c contract counter )
  >>=? fun c ->
  Storage.Contract.Balance.init c contract balance
  >>=? fun c ->
  ( match manager with
  | Some manager ->
      Storage.Contract.Manager.init c contract (Manager_repr.Hash manager)
  | None ->
      return c )
  >>=? fun c ->
  ( match delegate with
  | None ->
      return c
  | Some delegate ->
      Delegate_storage.init c contract delegate )
  >>=? fun c ->
  match script with
  | Some ({Script_repr.code; storage}, big_map_diff) ->
      Storage.Contract.Code.init c contract code
      >>=? fun (c, code_size) ->
      Storage.Contract.Storage.init c contract storage
      >>=? fun (c, storage_size) ->
      update_script_big_map c big_map_diff
      >>=? fun (c, big_map_size) ->
      let total_size =
        Z.add (Z.add (Z.of_int code_size) (Z.of_int storage_size)) big_map_size
      in
      assert (Compare.Z.(total_size >= Z.zero)) ;
      let prepaid_bootstrap_storage =
        if prepaid_bootstrap_storage then total_size else Z.zero
      in
      Storage.Contract.Paid_storage_space.init
        c
        contract
        prepaid_bootstrap_storage
      >>=? fun c ->
      Storage.Contract.Used_storage_space.init c contract total_size
  | None ->
      return c

let originate c ?prepaid_bootstrap_storage contract ~balance ~script ~delegate
    =
  create_base
    c
    ?prepaid_bootstrap_storage
    contract
    ~balance
    ~manager:None
    ~delegate
    ~script
    ()

let create_implicit c manager ~balance =
  create_base
    c
    (Contract_repr.implicit_contract manager)
    ~balance
    ~manager:(Some manager)
    ?script:None
    ~delegate:None
    ()

let delete c contract =
  match Contract_repr.is_implicit contract with
  | None ->
      (* For non implicit contract Big_map should be cleared *)
      failwith "Non implicit contracts cannot be removed"
  | Some _ ->
      Delegate_storage.remove c contract
      >>=? fun c ->
      Storage.Contract.Balance.delete c contract
      >>=? fun c ->
      Storage.Contract.Manager.delete c contract
      >>=? fun c ->
      Storage.Contract.Counter.delete c contract
      >>=? fun c ->
      Storage.Contract.Code.remove c contract
      >>=? fun (c, _, _) ->
      Storage.Contract.Storage.remove c contract
      >>=? fun (c, _, _) ->
      Storage.Contract.Paid_storage_space.remove c contract
      >>= fun c ->
      Storage.Contract.Used_storage_space.remove c contract
      >>= fun c -> return c

let allocated c contract =
  Storage.Contract.Balance.get_option c contract
  >>=? function None -> return_false | Some _ -> return_true

let exists c contract =
  match Contract_repr.is_implicit contract with
  | Some _ ->
      return_true
  | None ->
      allocated c contract

let must_exist c contract =
  exists c contract
  >>=? function
  | true -> return_unit | false -> fail (Non_existing_contract contract)

let must_be_allocated c contract =
  allocated c contract
  >>=? function
  | true ->
      return_unit
  | false -> (
    match Contract_repr.is_implicit contract with
    | Some pkh ->
        fail (Empty_implicit_contract pkh)
    | None ->
        fail (Non_existing_contract contract) )

let list c = Storage.Contract.list c

let fresh_contract_from_current_nonce c =
  Lwt.return (Raw_context.increment_origination_nonce c)
  >>=? fun (c, nonce) -> return (c, Contract_repr.originated_contract nonce)

let originated_from_current_nonce ~since:ctxt_since ~until:ctxt_until =
  Lwt.return (Raw_context.origination_nonce ctxt_since)
  >>=? fun since ->
  Lwt.return (Raw_context.origination_nonce ctxt_until)
  >>=? fun until ->
  filter_map_s
    (fun contract ->
      exists ctxt_until contract
      >>=? function true -> return_some contract | false -> return_none)
    (Contract_repr.originated_contracts ~since ~until)

let check_counter_increment c manager counter =
  let contract = Contract_repr.implicit_contract manager in
  Storage.Contract.Counter.get c contract
  >>=? fun contract_counter ->
  let expected = Z.succ contract_counter in
  if Compare.Z.(expected = counter) then return_unit
  else if Compare.Z.(expected > counter) then
    fail (Counter_in_the_past (contract, expected, counter))
  else fail (Counter_in_the_future (contract, expected, counter))

let increment_counter c manager =
  let contract = Contract_repr.implicit_contract manager in
  Storage.Contract.Global_counter.get c
  >>=? fun global_counter ->
  Storage.Contract.Global_counter.set c (Z.succ global_counter)
  >>=? fun c ->
  Storage.Contract.Counter.get c contract
  >>=? fun contract_counter ->
  Storage.Contract.Counter.set c contract (Z.succ contract_counter)

let get_script_code c contract = Storage.Contract.Code.get_option c contract

let get_script c contract =
  Storage.Contract.Code.get_option c contract
  >>=? fun (c, code) ->
  Storage.Contract.Storage.get_option c contract
  >>=? fun (c, storage) ->
  match (code, storage) with
  | (None, None) ->
      return (c, None)
  | (Some code, Some storage) ->
      return (c, Some {Script_repr.code; storage})
  | (None, Some _) | (Some _, None) ->
      failwith "get_script"

let get_storage ctxt contract =
  Storage.Contract.Storage.get_option ctxt contract
  >>=? function
  | (ctxt, None) ->
      return (ctxt, None)
  | (ctxt, Some storage) ->
      Lwt.return (Script_repr.force_decode storage)
      >>=? fun (storage, cost) ->
      Lwt.return (Raw_context.consume_gas ctxt cost)
      >>=? fun ctxt -> return (ctxt, Some storage)

let get_counter c manager =
  let contract = Contract_repr.implicit_contract manager in
  Storage.Contract.Counter.get_option c contract
  >>=? function
  | None -> (
    match Contract_repr.is_implicit contract with
    | Some _ ->
        Storage.Contract.Global_counter.get c
    | None ->
        failwith "get_counter" )
  | Some v ->
      return v

let get_manager_key c manager =
  let contract = Contract_repr.implicit_contract manager in
  Storage.Contract.Manager.get_option c contract
  >>=? function
  | None ->
      failwith "get_manager_key"
  | Some (Manager_repr.Hash _) ->
      fail (Unrevealed_manager_key contract)
  | Some (Manager_repr.Public_key v) ->
      return v

let is_manager_key_revealed c manager =
  let contract = Contract_repr.implicit_contract manager in
  Storage.Contract.Manager.get_option c contract
  >>=? function
  | None ->
      return_false
  | Some (Manager_repr.Hash _) ->
      return_false
  | Some (Manager_repr.Public_key _) ->
      return_true

let reveal_manager_key c manager public_key =
  let contract = Contract_repr.implicit_contract manager in
  Storage.Contract.Manager.get c contract
  >>=? function
  | Public_key _ ->
      fail (Previously_revealed_key contract)
  | Hash v ->
      let actual_hash = Signature.Public_key.hash public_key in
      if Signature.Public_key_hash.equal actual_hash v then
        let v = Manager_repr.Public_key public_key in
        Storage.Contract.Manager.set c contract v >>=? fun c -> return c
      else fail (Inconsistent_hash (public_key, v, actual_hash))

let get_balance c contract =
  Storage.Contract.Balance.get_option c contract
  >>=? function
  | None -> (
    match Contract_repr.is_implicit contract with
    | Some _ ->
        return Tez_repr.zero
    | None ->
        failwith "get_balance" )
  | Some v ->
      return v

let update_script_storage c contract storage big_map_diff =
  let storage = Script_repr.lazy_expr storage in
  update_script_big_map c big_map_diff
  >>=? fun (c, big_map_size_diff) ->
  Storage.Contract.Storage.set c contract storage
  >>=? fun (c, size_diff) ->
  Storage.Contract.Used_storage_space.get c contract
  >>=? fun previous_size ->
  let new_size =
    Z.add previous_size (Z.add big_map_size_diff (Z.of_int size_diff))
  in
  Storage.Contract.Used_storage_space.set c contract new_size

let spend c contract amount =
  Storage.Contract.Balance.get c contract
  >>=? fun balance ->
  match Tez_repr.(balance -? amount) with
  | Error _ ->
      fail (Balance_too_low (contract, balance, amount))
  | Ok new_balance -> (
      Storage.Contract.Balance.set c contract new_balance
      >>=? fun c ->
      Roll_storage.Contract.remove_amount c contract amount
      >>=? fun c ->
      if Tez_repr.(new_balance > Tez_repr.zero) then return c
      else
        match Contract_repr.is_implicit contract with
        | None ->
            return c (* Never delete originated contracts *)
        | Some pkh -> (
            Delegate_storage.get c contract
            >>=? function
            | Some pkh' ->
                (* Don't delete "delegate" contract *)
                assert (Signature.Public_key_hash.equal pkh pkh') ;
                return c
            | None ->
                (* Delete empty implicit contract *)
                delete c contract ) )

let credit c contract amount =
  ( if Tez_repr.(amount <> Tez_repr.zero) then return c
  else
    Storage.Contract.Code.mem c contract
    >>=? fun (c, target_has_code) ->
    fail_unless target_has_code (Empty_transaction contract)
    >>=? fun () -> return c )
  >>=? fun c ->
  Storage.Contract.Balance.get_option c contract
  >>=? function
  | None -> (
    match Contract_repr.is_implicit contract with
    | None ->
        fail (Non_existing_contract contract)
    | Some manager ->
        create_implicit c manager ~balance:amount )
  | Some balance ->
      Lwt.return Tez_repr.(amount +? balance)
      >>=? fun balance ->
      Storage.Contract.Balance.set c contract balance
      >>=? fun c -> Roll_storage.Contract.add_amount c contract amount

let init c = Storage.Contract.Global_counter.init c Z.zero

let used_storage_space c contract =
  Storage.Contract.Used_storage_space.get_option c contract
  >>=? function None -> return Z.zero | Some fees -> return fees

let paid_storage_space c contract =
  Storage.Contract.Paid_storage_space.get_option c contract
  >>=? function None -> return Z.zero | Some paid_space -> return paid_space

let set_paid_storage_space_and_return_fees_to_pay c contract new_storage_space
    =
  Storage.Contract.Paid_storage_space.get c contract
  >>=? fun already_paid_space ->
  if Compare.Z.(already_paid_space >= new_storage_space) then return (Z.zero, c)
  else
    let to_pay = Z.sub new_storage_space already_paid_space in
    Storage.Contract.Paid_storage_space.set c contract new_storage_space
    >>=? fun c -> return (to_pay, c)
contract_storage_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.unspendable_contract" % string
      "Unspendable contract" % string
      "An operation tried to spend tokens from an unspendable contract" % string
      (Some
        (fun ppf =>
          fun c =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "The tokens of contract " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " can only be spent by its script" % string
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "The tokens of contract %a can only be spent by its script" %
                  string) Contract_repr.pp c))
      (obj1 (req None None "contract" % string Contract_repr.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unspendable_contract
            c => Some c
        | _ => None
        end)
      (fun c =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unspendable_contract
          c) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.balance_too_low" % string "Balance too low" % string
      "An operation tried to spend more tokens than the contract has" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(c, b, a) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Balance of contract " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " too low (" % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                          ") to spend " % string
                          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))))))
                "Balance of contract %a too low (%a) to spend %a" % string)
              Contract_repr.pp c Tez_repr.pp b Tez_repr.pp a))
      (obj3 (req None None "contract" % string Contract_repr.encoding)
        (req None None "balance" % string Tez_repr.encoding)
        (req None None "amount" % string Tez_repr.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
            c b a => Some (c, b, a)
        | _ => None
        end)
      (fun function_parameter =>
        let '(c, b, a) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
          c b a) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.counter_in_the_future" % string
      "Invalid counter (not yet reached) in a manager operation" % string
      "An operation assumed a contract counter in the future" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(contract, exp, found) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Counter " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " not yet reached for contract " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                          " (expected " % string
                          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                              ")" % char
                              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))))
                "Counter %s not yet reached for contract %a (expected %s)" %
                  string) (Z.to_string found) Contract_repr.pp contract
              (Z.to_string exp)))
      (obj3 (req None None "contract" % string Contract_repr.encoding)
        (req None None "expected" % string z) (req None None "found" % string z))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Counter_in_the_future
            c x y => Some (c, x, y)
        | _ => None
        end)
      (fun function_parameter =>
        let '(c, x, y) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Counter_in_the_future
          c x y) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.counter_in_the_past" % string
      "Invalid counter (already used) in a manager operation" % string
      "An operation assumed a contract counter in the past" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(contract, exp, found) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Counter " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " already used for contract " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                          " (expected " % string
                          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                              ")" % char
                              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))))
                "Counter %s already used for contract %a (expected %s)" % string)
              (Z.to_string found) Contract_repr.pp contract (Z.to_string exp)))
      (obj3 (req None None "contract" % string Contract_repr.encoding)
        (req None None "expected" % string z) (req None None "found" % string z))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Counter_in_the_past
            c x y => Some (c, x, y)
        | _ => None
        end)
      (fun function_parameter =>
        let '(c, x, y) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Counter_in_the_past
          c x y) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.non_existing_contract" % string
      "Non existing contract" % string
      "A contract handle is not present in the context (either it never was or it has been destroyed)"
        % string
      (Some
        (fun ppf =>
          fun contract =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Contract " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " does not exist" % string
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Contract %a does not exist" % string) Contract_repr.pp contract))
      (obj1 (req None None "contract" % string Contract_repr.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Non_existing_contract
            c => Some c
        | _ => None
        end)
      (fun c =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Non_existing_contract
          c) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.manager.inconsistent_hash" % string
      "Inconsistent public key hash" % string
      "A revealed manager public key is inconsistent with the announced hash" %
        string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(k, eh, ph) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "The hash of the manager public key " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " is not " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                          " as announced but " % string
                          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))))))
                "The hash of the manager public key %s is not %a as announced but %a"
                  % string) (Signature.Public_key.to_b58check k)
              Signature.Public_key_hash.pp ph Signature.Public_key_hash.pp eh))
      (obj3 (req None None "public_key" % string Signature.Public_key.encoding)
        (req None None "expected_hash" % string
          Signature.Public_key_hash.encoding)
        (req None None "provided_hash" % string
          Signature.Public_key_hash.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_hash
            k eh ph => Some (k, eh, ph)
        | _ => None
        end)
      (fun function_parameter =>
        let '(k, eh, ph) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_hash
          k eh ph) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.manager.inconsistent_public_key" % string
      "Inconsistent public key" % string
      "A provided manager public key is different with the public key stored in the contract"
        % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let '(eh, ph) := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Expected manager public key " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " but " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                          " was provided" % string
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "Expected manager public key %s but %s was provided" % string)
              (Signature.Public_key.to_b58check ph)
              (Signature.Public_key.to_b58check eh)))
      (obj2 (req None None "public_key" % string Signature.Public_key.encoding)
        (req None None "expected_public_key" % string
          Signature.Public_key.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_public_key
            eh ph => Some (eh, ph)
        | _ => None
        end)
      (fun function_parameter =>
        let '(eh, ph) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_public_key
          eh ph) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.failure" % string "Contract storage failure" % string
      "Unexpected contract storage error" % string
      (Some
        (fun ppf =>
          fun s =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Contract_storage.Failure " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Caml_string
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))
                "Contract_storage.Failure %S" % string) s))
      (obj1 (req None None "message" % string string))
      (fun function_parameter =>
        match function_parameter with
        | Tezos_protocol_environment_alpha__Environment.Error_monad.Failure s =>
          Some s
        | _ => None
        end)
      (fun s =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Failure s) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.unrevealed_key" % string
      "Manager operation precedes key revelation" % string
      "One tried to apply a manager operation without revealing the manager public key"
        % string
      (Some
        (fun ppf =>
          fun s =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Unrevealed manager key for contract " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                      "." % char
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Unrevealed manager key for contract %a." % string)
              Contract_repr.pp s))
      (obj1 (req None None "contract" % string Contract_repr.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unrevealed_manager_key
            s => Some s
        | _ => None
        end)
      (fun s =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unrevealed_manager_key
          s) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.previously_revealed_key" % string
      "Manager operation already revealed" % string
      "One tried to revealed twice a manager public key" % string
      (Some
        (fun ppf =>
          fun s =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Previously revealed manager key for contract " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                      "." % char
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Previously revealed manager key for contract %a." % string)
              Contract_repr.pp s))
      (obj1 (req None None "contract" % string Contract_repr.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Previously_revealed_key
            s => Some s
        | _ => None
        end)
      (fun s =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Previously_revealed_key
          s) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "implicit.empty_implicit_contract" % string
      "Empty implicit contract" % string
      "No manager operations are allowed on an empty implicit contract." %
        string
      (Some
        (fun ppf =>
          fun implicit =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Empty implicit contract (" % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                      ")" % char
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Empty implicit contract (%a)" % string)
              Signature.Public_key_hash.pp implicit))
      (obj1
        (req None None "implicit" % string Signature.Public_key_hash.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_implicit_contract
            c => Some c
        | _ => None
        end)
      (fun c =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_implicit_contract
          c) in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "contract.empty_transaction" % string "Empty transaction" % string
    "Forbidden to credit 0ꜩ to a contract without code." % string
    (Some
      (fun ppf =>
        fun contract =>
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "Transaction of 0ꜩ towards a contract without code are forbidden ("
                  % string
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    ")." % string
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
              "Transaction of 0ꜩ towards a contract without code are forbidden (%a)."
                % string) Contract_repr.pp contract))
    (obj1 (req None None "contract" % string Contract_repr.encoding))
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_transaction
          c => Some c
      | _ => None
      end)
    (fun c =>
      Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_transaction
        c).

Definition failwith {A : Type} (msg : string)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  fail (Tezos_protocol_environment_alpha__Environment.Error_monad.Failure msg).

Inductive big_map_diff_item : Type :=
| Update : Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_raw_protocol_alpha.Script_repr.expr ->
  Tezos_raw_protocol_alpha.Script_expr_hash.t ->
  option Tezos_raw_protocol_alpha.Script_repr.expr -> big_map_diff_item
| Clear : Tezos_protocol_environment_alpha__Environment.Z.t -> big_map_diff_item
| Copy : Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t -> big_map_diff_item
| Alloc : Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_raw_protocol_alpha.Script_repr.expr ->
  Tezos_raw_protocol_alpha.Script_repr.expr -> big_map_diff_item.

Definition big_map_diff := list big_map_diff_item.

Definition big_map_diff_item_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    big_map_diff_item :=
  union None
    (cons
      (case "update" % string None
        (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
        (obj5 (req None None "action" % string (constant "update" % string))
          (req None None "big_map" % string z)
          (req None None "key_hash" % string Script_expr_hash.encoding)
          (req None None "key" % string Script_repr.expr_encoding)
          (opt None None "value" % string Script_repr.expr_encoding))
        (fun function_parameter =>
          match function_parameter with
          |
            Update {|
              big_map := big_map;
                diff_key := diff_key;
                diff_key_hash := diff_key_hash;
                diff_value := diff_value
                |} => Some (tt, big_map, diff_key_hash, diff_key, diff_value)
          | _ => None
          end)
        (fun function_parameter =>
          let '(tt, big_map, diff_key_hash, diff_key, diff_value) :=
            function_parameter in
          Update
            {| big_map := big_map; diff_key := diff_key;
              diff_key_hash := diff_key_hash; diff_value := diff_value |}))
      (cons
        (case "remove" % string None
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
          (obj2 (req None None "action" % string (constant "remove" % string))
            (req None None "big_map" % string z))
          (fun function_parameter =>
            match function_parameter with
            | Clear big_map => Some (tt, big_map)
            | _ => None
            end)
          (fun function_parameter =>
            let '(tt, big_map) := function_parameter in
            Clear big_map))
        (cons
          (case "copy" % string None
            (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 2)
            (obj3 (req None None "action" % string (constant "copy" % string))
              (req None None "source_big_map" % string z)
              (req None None "destination_big_map" % string z))
            (fun function_parameter =>
              match function_parameter with
              | Copy src dst => Some (tt, src, dst)
              | _ => None
              end)
            (fun function_parameter =>
              let '(tt, src, dst) := function_parameter in
              Copy src dst))
          (cons
            (case "alloc" % string None
              (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 3)
              (obj4
                (req None None "action" % string (constant "alloc" % string))
                (req None None "big_map" % string z)
                (req None None "key_type" % string Script_repr.expr_encoding)
                (req None None "value_type" % string Script_repr.expr_encoding))
              (fun function_parameter =>
                match function_parameter with
                |
                  Alloc {|
                    big_map := big_map;
                      key_type := key_type;
                      value_type := value_type
                      |} => Some (tt, big_map, key_type, value_type)
                | _ => None
                end)
              (fun function_parameter =>
                let '(tt, big_map, key_type, value_type) := function_parameter
                  in
                Alloc
                  {| big_map := big_map; key_type := key_type;
                    value_type := value_type |})) [])))).

Definition big_map_diff_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (list big_map_diff_item) :=
  op_atat
    (let arg := def "contract.big_map_diff" % string in
    fun eta => arg None None eta) (list None big_map_diff_item_encoding).

Definition big_map_key_cost : Z := 65.

Definition big_map_cost : Z := 33.

Definition update_script_big_map
  (c : Tezos_raw_protocol_alpha.Storage.Big_map.Total_bytes.context)
  (function_parameter : option (list big_map_diff_item))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Storage.Big_map.Total_bytes.context *
        Tezos_protocol_environment_alpha__Environment.Z.t)) :=
  match function_parameter with
  | None => __return (c, Z.zero)
  | Some diff =>
    fold_left_s
      (fun function_parameter =>
        let '(c, total) := function_parameter in
        fun function_parameter =>
          match function_parameter with
          | Clear id =>
            op_gtgteqquestion (Storage.Big_map.Total_bytes.get c id)
              (fun size =>
                op_gtgteq (Storage.Big_map.remove_rec c id)
                  (fun c =>
                    if
                      Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
                        id Z.zero then
                      __return (c, total)
                    else
                      __return
                        (c, (Z.sub (Z.sub total size) (Z.of_int big_map_cost)))))
          | Copy from to_ =>
            op_gtgteqquestion (Storage.Big_map.copy c from to_)
              (fun c =>
                if
                  Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
                    to_ Z.zero then
                  __return (c, total)
                else
                  op_gtgteqquestion (Storage.Big_map.Total_bytes.get c from)
                    (fun size =>
                      __return
                        (c, (Z.add (Z.add total size) (Z.of_int big_map_cost)))))
          |
            Alloc {|
              big_map := big_map;
                key_type := key_type;
                value_type := value_type
                |} =>
            op_gtgteqquestion
              (Storage.Big_map.Total_bytes.init c big_map Z.zero)
              (fun c =>
                let key_type :=
                  Micheline.strip_locations
                    (Script_repr.strip_annotations (Micheline.root key_type)) in
                let value_type :=
                  Micheline.strip_locations
                    (Script_repr.strip_annotations (Micheline.root value_type))
                  in
                op_gtgteqquestion
                  (Storage.Big_map.Key_type.init c big_map key_type)
                  (fun c =>
                    op_gtgteqquestion
                      (Storage.Big_map.Value_type.init c big_map value_type)
                      (fun c =>
                        if
                          Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
                            big_map Z.zero then
                          __return (c, total)
                        else
                          __return (c, (Z.add total (Z.of_int big_map_cost))))))
          |
            Update {|
              big_map := big_map;
                diff_key_hash := diff_key_hash;
                diff_value := None
                |} =>
            op_gtgteqquestion
              (Storage.Big_map.Contents.remove (c, big_map) diff_key_hash)
              (fun function_parameter =>
                let '(c, freed, existed) := function_parameter in
                let freed :=
                  if existed then
                    op_plus freed big_map_key_cost
                  else
                    freed in
                op_gtgteqquestion (Storage.Big_map.Total_bytes.get c big_map)
                  (fun size =>
                    op_gtgteqquestion
                      (Storage.Big_map.Total_bytes.set c big_map
                        (Z.sub size (Z.of_int freed)))
                      (fun c =>
                        if
                          Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
                            big_map Z.zero then
                          __return (c, total)
                        else
                          __return (c, (Z.sub total (Z.of_int freed))))))
          |
            Update {|
              big_map := big_map;
                diff_key_hash := diff_key_hash;
                diff_value := Some v
                |} =>
            op_gtgteqquestion
              (Storage.Big_map.Contents.init_set (c, big_map) diff_key_hash v)
              (fun function_parameter =>
                let '(c, size_diff, existed) := function_parameter in
                let size_diff :=
                  if existed then
                    size_diff
                  else
                    op_plus size_diff big_map_key_cost in
                op_gtgteqquestion (Storage.Big_map.Total_bytes.get c big_map)
                  (fun size =>
                    op_gtgteqquestion
                      (Storage.Big_map.Total_bytes.set c big_map
                        (Z.add size (Z.of_int size_diff)))
                      (fun c =>
                        if
                          Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
                            big_map Z.zero then
                          __return (c, total)
                        else
                          __return (c, (Z.add total (Z.of_int size_diff))))))
          end) (c, Z.zero) diff
  end.

Definition create_base
  (c : Tezos_raw_protocol_alpha.Raw_context.t) (op_staroptstar : option bool)
  : Tezos_raw_protocol_alpha.Contract_repr.contract ->
    Tezos_raw_protocol_alpha.Storage.Contract.Balance.value ->
      option
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
        ->
        option
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
          ->
          option
            (Tezos_raw_protocol_alpha.Script_repr.t *
              option (list big_map_diff_item)) ->
            unit ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                  Tezos_raw_protocol_alpha.Raw_context.t) :=
  let prepaid_bootstrap_storage :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => false
    end in
  fun contract =>
    fun balance =>
      fun manager =>
        fun delegate =>
          fun script =>
            fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteqquestion
                match Contract_repr.is_implicit contract with
                | None => __return c
                | Some _ =>
                  op_gtgteqquestion (Storage.Contract.Global_counter.get c)
                    (fun counter =>
                      Storage.Contract.Counter.init c contract counter)
                end
                (fun c =>
                  op_gtgteqquestion
                    (Storage.Contract.Balance.init c contract balance)
                    (fun c =>
                      op_gtgteqquestion
                        match manager with
                        | Some manager =>
                          Storage.Contract.Manager.init c contract
                            (Tezos_raw_protocol_alpha.Manager_repr.Hash manager)
                        | None => __return c
                        end
                        (fun c =>
                          op_gtgteqquestion
                            match delegate with
                            | None => __return c
                            | Some delegate =>
                              Delegate_storage.init c contract delegate
                            end
                            (fun c =>
                              match script with
                              |
                                Some
                                  ({|
                                    Script_repr.code := code;
                                      Script_repr.storage := storage
                                      |}, big_map_diff) =>
                                op_gtgteqquestion
                                  (Storage.Contract.Code.init c contract code)
                                  (fun function_parameter =>
                                    let '(c, code_size) := function_parameter in
                                    op_gtgteqquestion
                                      (Storage.Contract.Storage.init c contract
                                        storage)
                                      (fun function_parameter =>
                                        let '(c, storage_size) :=
                                          function_parameter in
                                        op_gtgteqquestion
                                          (update_script_big_map c big_map_diff)
                                          (fun function_parameter =>
                                            let '(c, big_map_size) :=
                                              function_parameter in
                                            let total_size :=
                                              Z.add
                                                (Z.add (Z.of_int code_size)
                                                  (Z.of_int storage_size))
                                                big_map_size in
                                            (* ❌ Sequences of instructions are not handled (operator ";") *)
                                            let _ :=
                                              (* ❌ Assert instruction is not handled. *)
                                              assert
                                                (Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
                                                  total_size Z.zero) in
                                            let prepaid_bootstrap_storage :=
                                              if prepaid_bootstrap_storage then
                                                total_size
                                              else
                                                Z.zero in
                                            op_gtgteqquestion
                                              (Storage.Contract.Paid_storage_space.init
                                                c contract
                                                prepaid_bootstrap_storage)
                                              (fun c =>
                                                Storage.Contract.Used_storage_space.init
                                                  c contract total_size))))
                              | None => __return c
                              end)))).

Definition originate
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  (prepaid_bootstrap_storage : option bool)
  (contract : Tezos_raw_protocol_alpha.Contract_repr.contract)
  (balance : Tezos_raw_protocol_alpha.Storage.Contract.Balance.value)
  (script :
    Tezos_raw_protocol_alpha.Script_repr.t * option (list big_map_diff_item))
  (delegate :
    option
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  create_base c prepaid_bootstrap_storage contract balance None delegate
    (Some script) tt.

Definition create_implicit
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  (manager :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (balance : Tezos_raw_protocol_alpha.Storage.Contract.Balance.value)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  create_base c None (Contract_repr.implicit_contract manager) balance
    (Some manager) None None tt.

Definition delete
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  (contract : Tezos_raw_protocol_alpha.Contract_repr.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  match Contract_repr.is_implicit contract with
  | None => failwith "Non implicit contracts cannot be removed" % string
  | Some _ =>
    op_gtgteqquestion (Delegate_storage.remove c contract)
      (fun c =>
        op_gtgteqquestion (Storage.Contract.Balance.delete c contract)
          (fun c =>
            op_gtgteqquestion (Storage.Contract.Manager.delete c contract)
              (fun c =>
                op_gtgteqquestion (Storage.Contract.Counter.delete c contract)
                  (fun c =>
                    op_gtgteqquestion (Storage.Contract.Code.remove c contract)
                      (fun function_parameter =>
                        let '(c, _, _) := function_parameter in
                        op_gtgteqquestion
                          (Storage.Contract.Storage.remove c contract)
                          (fun function_parameter =>
                            let '(c, _, _) := function_parameter in
                            op_gtgteq
                              (Storage.Contract.Paid_storage_space.remove c
                                contract)
                              (fun c =>
                                op_gtgteq
                                  (Storage.Contract.Used_storage_space.remove c
                                    contract) (fun c => __return c))))))))
  end.

Definition allocated
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Balance.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Balance.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool) :=
  op_gtgteqquestion (Storage.Contract.Balance.get_option c contract)
    (fun function_parameter =>
      match function_parameter with
      | None => return_false
      | Some _ => return_true
      end).

Definition __exists
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Balance.context)
  (contract : Tezos_raw_protocol_alpha.Contract_repr.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool) :=
  match Contract_repr.is_implicit contract with
  | Some _ => return_true
  | None => allocated c contract
  end.

Definition must_exist
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Balance.context)
  (contract : Tezos_raw_protocol_alpha.Contract_repr.contract)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  op_gtgteqquestion (__exists c contract)
    (fun function_parameter =>
      match function_parameter with
      | true => return_unit
      | false =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Non_existing_contract
            contract)
      end).

Definition must_be_allocated
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Balance.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Balance.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  op_gtgteqquestion (allocated c contract)
    (fun function_parameter =>
      match function_parameter with
      | true => return_unit
      | false =>
        match Contract_repr.is_implicit contract with
        | Some pkh =>
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_implicit_contract
              pkh)
        | None =>
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Non_existing_contract
              contract)
        end
      end).

Definition list (c : Tezos_raw_protocol_alpha.Raw_context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (list Tezos_raw_protocol_alpha.Contract_repr.t) := Storage.Contract.list c.

Definition fresh_contract_from_current_nonce
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        Tezos_raw_protocol_alpha.Contract_repr.contract)) :=
  op_gtgteqquestion (Lwt.__return (Raw_context.increment_origination_nonce c))
    (fun function_parameter =>
      let '(c, nonce) := function_parameter in
      __return (c, (Contract_repr.originated_contract nonce))).

Definition originated_from_current_nonce
  (ctxt_since : Tezos_raw_protocol_alpha.Raw_context.t)
  (ctxt_until : Tezos_raw_protocol_alpha.Raw_context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list Tezos_raw_protocol_alpha.Contract_repr.contract)) :=
  op_gtgteqquestion (Lwt.__return (Raw_context.origination_nonce ctxt_since))
    (fun since =>
      op_gtgteqquestion
        (Lwt.__return (Raw_context.origination_nonce ctxt_until))
        (fun until =>
          filter_map_s
            (fun contract =>
              op_gtgteqquestion (__exists ctxt_until contract)
                (fun function_parameter =>
                  match function_parameter with
                  | true => return_some contract
                  | false => return_none
                  end)) (Contract_repr.originated_contracts since until))).

Definition check_counter_increment
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Counter.context)
  (manager :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (counter :
    Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let contract := Contract_repr.implicit_contract manager in
  op_gtgteqquestion (Storage.Contract.Counter.get c contract)
    (fun contract_counter =>
      let expected := Z.succ contract_counter in
      if
        Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
          expected counter then
        return_unit
      else
        if
          Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
            expected counter then
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Counter_in_the_past
              contract expected counter)
        else
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Counter_in_the_future
              contract expected counter)).

Definition increment_counter
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  (manager :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let contract := Contract_repr.implicit_contract manager in
  op_gtgteqquestion (Storage.Contract.Global_counter.get c)
    (fun global_counter =>
      op_gtgteqquestion
        (Storage.Contract.Global_counter.set c (Z.succ global_counter))
        (fun c =>
          op_gtgteqquestion (Storage.Contract.Counter.get c contract)
            (fun contract_counter =>
              Storage.Contract.Counter.set c contract (Z.succ contract_counter)))).

Definition get_script_code
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Code.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Code.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        option Tezos_raw_protocol_alpha.Storage.Contract.Code.value)) :=
  Storage.Contract.Code.get_option c contract.

Definition get_script
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Code.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Code.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        option Tezos_raw_protocol_alpha.Script_repr.t)) :=
  op_gtgteqquestion (Storage.Contract.Code.get_option c contract)
    (fun function_parameter =>
      let '(c, code) := function_parameter in
      op_gtgteqquestion (Storage.Contract.Storage.get_option c contract)
        (fun function_parameter =>
          let '(c, storage) := function_parameter in
          match (code, storage) with
          | (None, None) => __return (c, None)
          | (Some code, Some storage) =>
            __return
              (c,
                (Some
                  {| Script_repr.code := code; Script_repr.storage := storage |}))
          | (None, Some _) | (Some _, None) => failwith "get_script" % string
          end)).

Definition get_storage
  (ctxt : Tezos_raw_protocol_alpha.Storage.Contract.Storage.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Storage.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        option Tezos_raw_protocol_alpha.Script_repr.expr)) :=
  op_gtgteqquestion (Storage.Contract.Storage.get_option ctxt contract)
    (fun function_parameter =>
      match function_parameter with
      | (ctxt, None) => __return (ctxt, None)
      | (ctxt, Some storage) =>
        op_gtgteqquestion (Lwt.__return (Script_repr.force_decode storage))
          (fun function_parameter =>
            let '(storage, cost) := function_parameter in
            op_gtgteqquestion (Lwt.__return (Raw_context.consume_gas ctxt cost))
              (fun ctxt => __return (ctxt, (Some storage))))
      end).

Definition get_counter
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Counter.context)
  (manager :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Z.t) :=
  let contract := Contract_repr.implicit_contract manager in
  op_gtgteqquestion (Storage.Contract.Counter.get_option c contract)
    (fun function_parameter =>
      match function_parameter with
      | None =>
        match Contract_repr.is_implicit contract with
        | Some _ => Storage.Contract.Global_counter.get c
        | None => failwith "get_counter" % string
        end
      | Some v => __return v
      end).

Definition get_manager_key
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Manager.context)
  (manager :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t) :=
  let contract := Contract_repr.implicit_contract manager in
  op_gtgteqquestion (Storage.Contract.Manager.get_option c contract)
    (fun function_parameter =>
      match function_parameter with
      | None => failwith "get_manager_key" % string
      | Some (Tezos_raw_protocol_alpha.Manager_repr.Hash _) =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Unrevealed_manager_key
            contract)
      | Some (Tezos_raw_protocol_alpha.Manager_repr.Public_key v) => __return v
      end).

Definition is_manager_key_revealed
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Manager.context)
  (manager :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool) :=
  let contract := Contract_repr.implicit_contract manager in
  op_gtgteqquestion (Storage.Contract.Manager.get_option c contract)
    (fun function_parameter =>
      match function_parameter with
      | None => return_false
      | Some (Tezos_raw_protocol_alpha.Manager_repr.Hash _) => return_false
      | Some (Tezos_raw_protocol_alpha.Manager_repr.Public_key _) => return_true
      end).

Definition reveal_manager_key
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Manager.context)
  (manager :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (public_key :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let contract := Contract_repr.implicit_contract manager in
  op_gtgteqquestion (Storage.Contract.Manager.get c contract)
    (fun function_parameter =>
      match function_parameter with
      | Tezos_raw_protocol_alpha.Manager_repr.Public_key _ =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Previously_revealed_key
            contract)
      | Tezos_raw_protocol_alpha.Manager_repr.Hash v =>
        let actual_hash := Signature.Public_key.hash public_key in
        if Signature.Public_key_hash.equal actual_hash v then
          let v := Tezos_raw_protocol_alpha.Manager_repr.Public_key public_key
            in
          op_gtgteqquestion (Storage.Contract.Manager.set c contract v)
            (fun c => __return c)
        else
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_hash
              public_key v actual_hash)
      end).

Definition get_balance
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Balance.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Balance.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t) :=
  op_gtgteqquestion (Storage.Contract.Balance.get_option c contract)
    (fun function_parameter =>
      match function_parameter with
      | None =>
        match Contract_repr.is_implicit contract with
        | Some _ => __return Tez_repr.zero
        | None => failwith "get_balance" % string
        end
      | Some v => __return v
      end).

Definition update_script_storage
  (c : Tezos_raw_protocol_alpha.Storage.Big_map.Total_bytes.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Storage.key)
  (storage : Tezos_raw_protocol_alpha.Script_repr.expr)
  (big_map_diff : option (list big_map_diff_item))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let storage := Script_repr.lazy_expr storage in
  op_gtgteqquestion (update_script_big_map c big_map_diff)
    (fun function_parameter =>
      let '(c, big_map_size_diff) := function_parameter in
      op_gtgteqquestion (Storage.Contract.Storage.set c contract storage)
        (fun function_parameter =>
          let '(c, size_diff) := function_parameter in
          op_gtgteqquestion (Storage.Contract.Used_storage_space.get c contract)
            (fun previous_size =>
              let new_size :=
                Z.add previous_size
                  (Z.add big_map_size_diff (Z.of_int size_diff)) in
              Storage.Contract.Used_storage_space.set c contract new_size))).

Definition spend
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Balance.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Balance.key)
  (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteqquestion (Storage.Contract.Balance.get c contract)
    (fun balance =>
      match op_minusquestion balance amount with
      | Tezos_protocol_environment_alpha__Environment.Pervasives.Error _ =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
            contract balance amount)
      | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok new_balance
        =>
        op_gtgteqquestion (Storage.Contract.Balance.set c contract new_balance)
          (fun c =>
            op_gtgteqquestion
              (Roll_storage.Contract.remove_amount c contract amount)
              (fun c =>
                if op_gt new_balance Tez_repr.zero then
                  __return c
                else
                  match Contract_repr.is_implicit contract with
                  | None => __return c
                  | Some pkh =>
                    op_gtgteqquestion (Delegate_storage.get c contract)
                      (fun function_parameter =>
                        match function_parameter with
                        | Some pkh' =>
                          (* ❌ Sequences of instructions are not handled (operator ";") *)
                          let _ :=
                            (* ❌ Assert instruction is not handled. *)
                            assert (Signature.Public_key_hash.equal pkh pkh') in
                          __return c
                        | None => delete c contract
                        end)
                  end))
      end).

Definition credit
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Code.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Code.key)
  (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteqquestion
    (if op_ltgt amount Tez_repr.zero then
      __return c
    else
      op_gtgteqquestion (Storage.Contract.Code.mem c contract)
        (fun function_parameter =>
          let '(c, target_has_code) := function_parameter in
          op_gtgteqquestion
            (fail_unless target_has_code
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_transaction
                contract))
            (fun function_parameter =>
              let 'tt := function_parameter in
              __return c)))
    (fun c =>
      op_gtgteqquestion (Storage.Contract.Balance.get_option c contract)
        (fun function_parameter =>
          match function_parameter with
          | None =>
            match Contract_repr.is_implicit contract with
            | None =>
              fail
                (Tezos_protocol_environment_alpha__Environment.Error_monad.Non_existing_contract
                  contract)
            | Some manager => create_implicit c manager amount
            end
          | Some balance =>
            op_gtgteqquestion (Lwt.__return (op_plusquestion amount balance))
              (fun balance =>
                op_gtgteqquestion
                  (Storage.Contract.Balance.set c contract balance)
                  (fun c => Roll_storage.Contract.add_amount c contract amount))
          end)).

Definition init (c : Tezos_raw_protocol_alpha.Raw_context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  Storage.Contract.Global_counter.init c Z.zero.

Definition used_storage_space
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Used_storage_space.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Used_storage_space.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Z.t) :=
  op_gtgteqquestion (Storage.Contract.Used_storage_space.get_option c contract)
    (fun function_parameter =>
      match function_parameter with
      | None => __return Z.zero
      | Some fees => __return fees
      end).

Definition paid_storage_space
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Paid_storage_space.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Paid_storage_space.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Z.t) :=
  op_gtgteqquestion (Storage.Contract.Paid_storage_space.get_option c contract)
    (fun function_parameter =>
      match function_parameter with
      | None => __return Z.zero
      | Some paid_space => __return paid_space
      end).

Definition set_paid_storage_space_and_return_fees_to_pay
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Paid_storage_space.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Paid_storage_space.key)
  (new_storage_space :
    Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.Z.t *
        Tezos_raw_protocol_alpha.Storage.Contract.Paid_storage_space.context)) :=
  op_gtgteqquestion (Storage.Contract.Paid_storage_space.get c contract)
    (fun already_paid_space =>
      if
        Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
          already_paid_space new_storage_space then
        __return (Z.zero, c)
      else
        let to_pay := Z.sub new_storage_space already_paid_space in
        op_gtgteqquestion
          (Storage.Contract.Paid_storage_space.set c contract new_storage_space)
          (fun c => __return (to_pay, c))).
contract_storage.mli 4 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type error +=
  | Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t
  | (* `Temporary *)
      Counter_in_the_past of Contract_repr.contract * Z.t * Z.t
  | (* `Branch *)
      Counter_in_the_future of Contract_repr.contract * Z.t * Z.t
  | (* `Temporary *)
      Unspendable_contract of Contract_repr.contract
  | (* `Permanent *)
      Non_existing_contract of Contract_repr.contract
  | (* `Temporary *)
      Empty_implicit_contract of Signature.Public_key_hash.t
  | (* `Temporary *)
      Empty_transaction of Contract_repr.t (* `Temporary *)
  | Inconsistent_hash of
      Signature.Public_key.t
      * Signature.Public_key_hash.t
      * Signature.Public_key_hash.t
  | (* `Permanent *)
      Inconsistent_public_key of
      Signature.Public_key.t * Signature.Public_key.t
  | (* `Permanent *)
      Failure of string (* `Permanent *)
  | Previously_revealed_key of Contract_repr.t (* `Permanent *)
  | Unrevealed_manager_key of Contract_repr.t

(* `Permanent *)

val exists : Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t

val must_exist : Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t

val allocated : Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t

val must_be_allocated : Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t

val list : Raw_context.t -> Contract_repr.t list Lwt.t

val check_counter_increment :
  Raw_context.t -> Signature.Public_key_hash.t -> Z.t -> unit tzresult Lwt.t

val increment_counter :
  Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t

val get_manager_key :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Signature.Public_key.t tzresult Lwt.t

val is_manager_key_revealed :
  Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t

val reveal_manager_key :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Signature.Public_key.t ->
  Raw_context.t tzresult Lwt.t

val get_balance : Raw_context.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t

val get_counter :
  Raw_context.t -> Signature.Public_key_hash.t -> Z.t tzresult Lwt.t

val get_script_code :
  Raw_context.t ->
  Contract_repr.t ->
  (Raw_context.t * Script_repr.lazy_expr option) tzresult Lwt.t

val get_script :
  Raw_context.t ->
  Contract_repr.t ->
  (Raw_context.t * Script_repr.t option) tzresult Lwt.t

val get_storage :
  Raw_context.t ->
  Contract_repr.t ->
  (Raw_context.t * Script_repr.expr option) tzresult Lwt.t

type big_map_diff_item =
  | Update of {
      big_map : Z.t;
      diff_key : Script_repr.expr;
      diff_key_hash : Script_expr_hash.t;
      diff_value : Script_repr.expr option;
    }
  | Clear of Z.t
  | Copy of Z.t * Z.t
  | Alloc of {
      big_map : Z.t;
      key_type : Script_repr.expr;
      value_type : Script_repr.expr;
    }

type big_map_diff = big_map_diff_item list

val big_map_diff_encoding : big_map_diff Data_encoding.t

val update_script_storage :
  Raw_context.t ->
  Contract_repr.t ->
  Script_repr.expr ->
  big_map_diff option ->
  Raw_context.t tzresult Lwt.t

val credit :
  Raw_context.t ->
  Contract_repr.t ->
  Tez_repr.t ->
  Raw_context.t tzresult Lwt.t

val spend :
  Raw_context.t ->
  Contract_repr.t ->
  Tez_repr.t ->
  Raw_context.t tzresult Lwt.t

val originate :
  Raw_context.t ->
  ?prepaid_bootstrap_storage:bool ->
  Contract_repr.t ->
  balance:Tez_repr.t ->
  script:Script_repr.t * big_map_diff option ->
  delegate:Signature.Public_key_hash.t option ->
  Raw_context.t tzresult Lwt.t

val fresh_contract_from_current_nonce :
  Raw_context.t -> (Raw_context.t * Contract_repr.t) tzresult Lwt.t

val originated_from_current_nonce :
  since:Raw_context.t ->
  until:Raw_context.t ->
  Contract_repr.t list tzresult Lwt.t

val init : Raw_context.t -> Raw_context.t tzresult Lwt.t

val used_storage_space : Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t

val paid_storage_space : Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t

val set_paid_storage_space_and_return_fees_to_pay :
  Raw_context.t ->
  Contract_repr.t ->
  Z.t ->
  (Z.t * Raw_context.t) tzresult Lwt.t
contract_storage_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

extensible_type

Parameter __exists :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).

Parameter must_exist :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).

Parameter allocated :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).

Parameter must_be_allocated :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).

Parameter list :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (list Tezos_raw_protocol_alpha.Contract_repr.t).

Parameter check_counter_increment :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).

Parameter increment_counter :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).

Parameter get_manager_key :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t).

Parameter is_manager_key_revealed :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).

Parameter reveal_manager_key :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).

Parameter get_balance :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Tez_repr.t).

Parameter get_counter :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_protocol_environment_alpha__Environment.Z.t).

Parameter get_script_code :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Raw_context.t *
          option Tezos_raw_protocol_alpha.Script_repr.lazy_expr)).

Parameter get_script :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Raw_context.t *
          option Tezos_raw_protocol_alpha.Script_repr.t)).

Parameter get_storage :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Raw_context.t *
          option Tezos_raw_protocol_alpha.Script_repr.expr)).

Inductive big_map_diff_item : Type :=
| Update : Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_raw_protocol_alpha.Script_repr.expr ->
  Tezos_raw_protocol_alpha.Script_expr_hash.t ->
  option Tezos_raw_protocol_alpha.Script_repr.expr -> big_map_diff_item
| Clear : Tezos_protocol_environment_alpha__Environment.Z.t -> big_map_diff_item
| Copy : Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t -> big_map_diff_item
| Alloc : Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_raw_protocol_alpha.Script_repr.expr ->
  Tezos_raw_protocol_alpha.Script_repr.expr -> big_map_diff_item.

Definition big_map_diff := list big_map_diff_item.

Parameter big_map_diff_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t big_map_diff.

Parameter update_script_storage :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
    Tezos_raw_protocol_alpha.Script_repr.expr ->
      option big_map_diff ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Raw_context.t).

Parameter credit :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
    Tezos_raw_protocol_alpha.Tez_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).

Parameter spend :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
    Tezos_raw_protocol_alpha.Tez_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).

Parameter originate :
Tezos_raw_protocol_alpha.Raw_context.t ->
  option bool ->
    Tezos_raw_protocol_alpha.Contract_repr.t ->
      Tezos_raw_protocol_alpha.Tez_repr.t ->
        Tezos_raw_protocol_alpha.Script_repr.t * option big_map_diff ->
          option
            Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
            ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                Tezos_raw_protocol_alpha.Raw_context.t).

Parameter fresh_contract_from_current_nonce :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        Tezos_raw_protocol_alpha.Contract_repr.t)).

Parameter originated_from_current_nonce :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (list Tezos_raw_protocol_alpha.Contract_repr.t)).

Parameter init :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter used_storage_space :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_protocol_environment_alpha__Environment.Z.t).

Parameter paid_storage_space :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_protocol_environment_alpha__Environment.Z.t).

Parameter set_paid_storage_space_and_return_fees_to_pay :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_protocol_environment_alpha__Environment.Z.t *
            Tezos_raw_protocol_alpha.Raw_context.t)).
cycle_repr.ml 16 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = int32

type cycle = t

let encoding = Data_encoding.int32

let rpc_arg =
  let construct = Int32.to_string in
  let destruct str =
    match Int32.of_string str with
    | exception _ ->
        Error "Cannot parse cycle"
    | cycle ->
        Ok cycle
  in
  RPC_arg.make
    ~descr:"A cycle integer"
    ~name:"block_cycle"
    ~construct
    ~destruct
    ()

let pp ppf cycle = Format.fprintf ppf "%ld" cycle

include (Compare.Int32 : Compare.S with type t := t)

module Map = Map.Make (Compare.Int32)

let root = 0l

let succ = Int32.succ

let pred = function 0l -> None | i -> Some (Int32.pred i)

let add c i =
  assert (Compare.Int.(i > 0)) ;
  Int32.add c (Int32.of_int i)

let sub c i =
  assert (Compare.Int.(i > 0)) ;
  let r = Int32.sub c (Int32.of_int i) in
  if Compare.Int32.(r < 0l) then None else Some r

let to_int32 i = i

let of_int32_exn l =
  if Compare.Int32.(l >= 0l) then l
  else invalid_arg "Level_repr.Cycle.of_int32"

module Index = struct
  type t = cycle

  let path_length = 1

  let to_path c l = Int32.to_string (to_int32 c) :: l

  let of_path = function
    | [s] -> (
      try Some (Int32.of_string s) with _ -> None )
    | _ ->
        None

  let rpc_arg = rpc_arg

  let encoding = encoding

  let compare = compare
end
cycle_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition t := int32.

Definition cycle := t.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding int32 :=
  Data_encoding.int32.

Definition rpc_arg
  : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg int32 :=
  let construct := Int32.to_string in
  let destruct (str : string)
    : Tezos_protocol_environment_alpha__Environment.Pervasives.result int32
      string :=
    let 'cycle := Int32.of_string str in
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok cycle in
  RPC_arg.make (Some "A cycle integer" % string) "block_cycle" % string destruct
    construct tt.

Definition pp
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (cycle : int32) : unit :=
  Format.fprintf ppf
    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
      "%ld" % string) cycle.

Export Compare.Int32.

(* ❌ Applications of functors are not handled. *)
functor_application

Definition root : int32 :=
  (* ❌ Constant of type int32 is converted to int *)
  0.

Definition succ : int32 -> int32 := Int32.succ.

Definition pred (function_parameter : int32) : option int32 :=
  match function_parameter with
  |
    (* ❌ Constant of type int32 is converted to int *)
    0 => None
  | i => Some (Int32.pred i)
  end.

Definition add
  (c : int32)
  (i :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : int32 :=
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    (* ❌ Assert instruction is not handled. *)
    assert
      (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
        i 0) in
  Int32.add c (Int32.of_int i).

Definition sub
  (c : int32)
  (i :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : option int32 :=
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    (* ❌ Assert instruction is not handled. *)
    assert
      (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
        i 0) in
  let r := Int32.sub c (Int32.of_int i) in
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
      r
      (* ❌ Constant of type int32 is converted to int *)
      0 then
    None
  else
    Some r.

Definition to_int32 {A : Type} (i : A) : A := i.

Definition of_int32_exn
  (l :
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.t) :=
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
      l
      (* ❌ Constant of type int32 is converted to int *)
      0 then
    l
  else
    invalid_arg "Level_repr.Cycle.of_int32" % string.

Module Index.
  Definition t := cycle.
  
  Definition path_length : Z := 1.
  
  Definition to_path (c : int32) (l : list string) : list string :=
    cons (Int32.to_string (to_int32 c)) l.
  
  Definition of_path (function_parameter : list string) : option int32 :=
    match function_parameter with
    | cons s [] =>
      (* ❌ Try-with are not handled *)
      try (Some (Int32.of_string s))
    | _ => None
    end.
  
  Definition rpc_arg
    : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg int32 := rpc_arg.
  
  Definition encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding int32 :=
    encoding.
  
  Definition compare : t -> t -> Z := compare.
End Index.
cycle_repr.mli 4 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t

type cycle = t

include Compare.S with type t := t

val encoding : cycle Data_encoding.t

val rpc_arg : cycle RPC_arg.arg

val pp : Format.formatter -> cycle -> unit

val root : cycle

val pred : cycle -> cycle option

val add : cycle -> int -> cycle

val sub : cycle -> int -> cycle option

val succ : cycle -> cycle

val to_int32 : cycle -> int32

val of_int32_exn : int32 -> cycle

module Map : S.MAP with type key = cycle

module Index : Storage_description.INDEX with type t = cycle
cycle_repr_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter t : Type.

Definition cycle := t.

include

Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t cycle.

Parameter rpc_arg :
Tezos_protocol_environment_alpha__Environment.RPC_arg.arg cycle.

Parameter pp :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> cycle -> unit.

Parameter root : cycle.

Parameter pred : cycle -> option cycle.

Parameter add : cycle -> Z -> cycle.

Parameter sub : cycle -> Z -> option cycle.

Parameter succ : cycle -> cycle.

Parameter to_int32 : cycle -> int32.

Parameter of_int32_exn : int32 -> cycle.

unhandled_module

unhandled_module
delegate_services.ml 236 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

type info = {
  balance : Tez.t;
  frozen_balance : Tez.t;
  frozen_balance_by_cycle : Delegate.frozen_balance Cycle.Map.t;
  staking_balance : Tez.t;
  delegated_contracts : Contract_repr.t list;
  delegated_balance : Tez.t;
  deactivated : bool;
  grace_period : Cycle.t;
}

let info_encoding =
  let open Data_encoding in
  conv
    (fun { balance;
           frozen_balance;
           frozen_balance_by_cycle;
           staking_balance;
           delegated_contracts;
           delegated_balance;
           deactivated;
           grace_period } ->
      ( balance,
        frozen_balance,
        frozen_balance_by_cycle,
        staking_balance,
        delegated_contracts,
        delegated_balance,
        deactivated,
        grace_period ))
    (fun ( balance,
           frozen_balance,
           frozen_balance_by_cycle,
           staking_balance,
           delegated_contracts,
           delegated_balance,
           deactivated,
           grace_period ) ->
      {
        balance;
        frozen_balance;
        frozen_balance_by_cycle;
        staking_balance;
        delegated_contracts;
        delegated_balance;
        deactivated;
        grace_period;
      })
    (obj8
       (req "balance" Tez.encoding)
       (req "frozen_balance" Tez.encoding)
       (req "frozen_balance_by_cycle" Delegate.frozen_balance_by_cycle_encoding)
       (req "staking_balance" Tez.encoding)
       (req "delegated_contracts" (list Contract_repr.encoding))
       (req "delegated_balance" Tez.encoding)
       (req "deactivated" bool)
       (req "grace_period" Cycle.encoding))

module S = struct
  let path = RPC_path.(open_root / "context" / "delegates")

  open Data_encoding

  type list_query = {active : bool; inactive : bool}

  let list_query : list_query RPC_query.t =
    let open RPC_query in
    query (fun active inactive -> {active; inactive})
    |+ flag "active" (fun t -> t.active)
    |+ flag "inactive" (fun t -> t.inactive)
    |> seal

  let list_delegate =
    RPC_service.get_service
      ~description:"Lists all registered delegates."
      ~query:list_query
      ~output:(list Signature.Public_key_hash.encoding)
      path

  let path = RPC_path.(path /: Signature.Public_key_hash.rpc_arg)

  let info =
    RPC_service.get_service
      ~description:"Everything about a delegate."
      ~query:RPC_query.empty
      ~output:info_encoding
      path

  let balance =
    RPC_service.get_service
      ~description:
        "Returns the full balance of a given delegate, including the frozen \
         balances."
      ~query:RPC_query.empty
      ~output:Tez.encoding
      RPC_path.(path / "balance")

  let frozen_balance =
    RPC_service.get_service
      ~description:
        "Returns the total frozen balances of a given delegate, this includes \
         the frozen deposits, rewards and fees."
      ~query:RPC_query.empty
      ~output:Tez.encoding
      RPC_path.(path / "frozen_balance")

  let frozen_balance_by_cycle =
    RPC_service.get_service
      ~description:
        "Returns the frozen balances of a given delegate, indexed by the \
         cycle by which it will be unfrozen"
      ~query:RPC_query.empty
      ~output:Delegate.frozen_balance_by_cycle_encoding
      RPC_path.(path / "frozen_balance_by_cycle")

  let staking_balance =
    RPC_service.get_service
      ~description:
        "Returns the total amount of tokens delegated to a given delegate. \
         This includes the balances of all the contracts that delegate to it, \
         but also the balance of the delegate itself and its frozen fees and \
         deposits. The rewards do not count in the delegated balance until \
         they are unfrozen."
      ~query:RPC_query.empty
      ~output:Tez.encoding
      RPC_path.(path / "staking_balance")

  let delegated_contracts =
    RPC_service.get_service
      ~description:
        "Returns the list of contracts that delegate to a given delegate."
      ~query:RPC_query.empty
      ~output:(list Contract_repr.encoding)
      RPC_path.(path / "delegated_contracts")

  let delegated_balance =
    RPC_service.get_service
      ~description:
        "Returns the balances of all the contracts that delegate to a given \
         delegate. This excludes the delegate's own balance and its frozen \
         balances."
      ~query:RPC_query.empty
      ~output:Tez.encoding
      RPC_path.(path / "delegated_balance")

  let deactivated =
    RPC_service.get_service
      ~description:
        "Tells whether the delegate is currently tagged as deactivated or not."
      ~query:RPC_query.empty
      ~output:bool
      RPC_path.(path / "deactivated")

  let grace_period =
    RPC_service.get_service
      ~description:
        "Returns the cycle by the end of which the delegate might be \
         deactivated if she fails to execute any delegate action. A \
         deactivated delegate might be reactivated (without loosing any \
         rolls) by simply re-registering as a delegate. For deactivated \
         delegates, this value contains the cycle by which they were \
         deactivated."
      ~query:RPC_query.empty
      ~output:Cycle.encoding
      RPC_path.(path / "grace_period")
end

let register () =
  let open Services_registration in
  register0 S.list_delegate (fun ctxt q () ->
      Delegate.list ctxt
      >>= fun delegates ->
      if q.active && q.inactive then return delegates
      else if q.active then
        filter_map_s
          (fun pkh ->
            Delegate.deactivated ctxt pkh
            >>=? function true -> return_none | false -> return_some pkh)
          delegates
      else if q.inactive then
        filter_map_s
          (fun pkh ->
            Delegate.deactivated ctxt pkh
            >>=? function false -> return_none | true -> return_some pkh)
          delegates
      else return_nil) ;
  register1 S.info (fun ctxt pkh () () ->
      Delegate.full_balance ctxt pkh
      >>=? fun balance ->
      Delegate.frozen_balance ctxt pkh
      >>=? fun frozen_balance ->
      Delegate.frozen_balance_by_cycle ctxt pkh
      >>= fun frozen_balance_by_cycle ->
      Delegate.staking_balance ctxt pkh
      >>=? fun staking_balance ->
      Delegate.delegated_contracts ctxt pkh
      >>= fun delegated_contracts ->
      Delegate.delegated_balance ctxt pkh
      >>=? fun delegated_balance ->
      Delegate.deactivated ctxt pkh
      >>=? fun deactivated ->
      Delegate.grace_period ctxt pkh
      >>=? fun grace_period ->
      return
        {
          balance;
          frozen_balance;
          frozen_balance_by_cycle;
          staking_balance;
          delegated_contracts;
          delegated_balance;
          deactivated;
          grace_period;
        }) ;
  register1 S.balance (fun ctxt pkh () () -> Delegate.full_balance ctxt pkh) ;
  register1 S.frozen_balance (fun ctxt pkh () () ->
      Delegate.frozen_balance ctxt pkh) ;
  register1 S.frozen_balance_by_cycle (fun ctxt pkh () () ->
      Delegate.frozen_balance_by_cycle ctxt pkh >>= return) ;
  register1 S.staking_balance (fun ctxt pkh () () ->
      Delegate.staking_balance ctxt pkh) ;
  register1 S.delegated_contracts (fun ctxt pkh () () ->
      Delegate.delegated_contracts ctxt pkh >>= return) ;
  register1 S.delegated_balance (fun ctxt pkh () () ->
      Delegate.delegated_balance ctxt pkh) ;
  register1 S.deactivated (fun ctxt pkh () () -> Delegate.deactivated ctxt pkh) ;
  register1 S.grace_period (fun ctxt pkh () () ->
      Delegate.grace_period ctxt pkh)

let list ctxt block ?(active = true) ?(inactive = false) () =
  RPC_context.make_call0 S.list_delegate ctxt block {active; inactive} ()

let info ctxt block pkh = RPC_context.make_call1 S.info ctxt block pkh () ()

let balance ctxt block pkh =
  RPC_context.make_call1 S.balance ctxt block pkh () ()

let frozen_balance ctxt block pkh =
  RPC_context.make_call1 S.frozen_balance ctxt block pkh () ()

let frozen_balance_by_cycle ctxt block pkh =
  RPC_context.make_call1 S.frozen_balance_by_cycle ctxt block pkh () ()

let staking_balance ctxt block pkh =
  RPC_context.make_call1 S.staking_balance ctxt block pkh () ()

let delegated_contracts ctxt block pkh =
  RPC_context.make_call1 S.delegated_contracts ctxt block pkh () ()

let delegated_balance ctxt block pkh =
  RPC_context.make_call1 S.delegated_balance ctxt block pkh () ()

let deactivated ctxt block pkh =
  RPC_context.make_call1 S.deactivated ctxt block pkh () ()

let grace_period ctxt block pkh =
  RPC_context.make_call1 S.grace_period ctxt block pkh () ()

let requested_levels ~default ctxt cycles levels =
  match (levels, cycles) with
  | ([], []) ->
      return [default]
  | (levels, cycles) ->
      (* explicitly fail when requested levels or cycle are in the past...
         or too far in the future... *)
      let levels =
        List.sort_uniq
          Level.compare
          (List.concat
             ( List.map (Level.from_raw ctxt) levels
             :: List.map (Level.levels_in_cycle ctxt) cycles ))
      in
      map_s
        (fun level ->
          let current_level = Level.current ctxt in
          if Level.(level <= current_level) then return (level, None)
          else
            Baking.earlier_predecessor_timestamp ctxt level
            >>=? fun timestamp -> return (level, Some timestamp))
        levels

module Baking_rights = struct
  type t = {
    level : Raw_level.t;
    delegate : Signature.Public_key_hash.t;
    priority : int;
    timestamp : Timestamp.t option;
  }

  let encoding =
    let open Data_encoding in
    conv
      (fun {level; delegate; priority; timestamp} ->
        (level, delegate, priority, timestamp))
      (fun (level, delegate, priority, timestamp) ->
        {level; delegate; priority; timestamp})
      (obj4
         (req "level" Raw_level.encoding)
         (req "delegate" Signature.Public_key_hash.encoding)
         (req "priority" uint16)
         (opt "estimated_time" Timestamp.encoding))

  module S = struct
    open Data_encoding

    let custom_root = RPC_path.(open_root / "helpers" / "baking_rights")

    type baking_rights_query = {
      levels : Raw_level.t list;
      cycles : Cycle.t list;
      delegates : Signature.Public_key_hash.t list;
      max_priority : int option;
      all : bool;
    }

    let baking_rights_query =
      let open RPC_query in
      query (fun levels cycles delegates max_priority all ->
          {levels; cycles; delegates; max_priority; all})
      |+ multi_field "level" Raw_level.rpc_arg (fun t -> t.levels)
      |+ multi_field "cycle" Cycle.rpc_arg (fun t -> t.cycles)
      |+ multi_field "delegate" Signature.Public_key_hash.rpc_arg (fun t ->
             t.delegates)
      |+ opt_field "max_priority" RPC_arg.int (fun t -> t.max_priority)
      |+ flag "all" (fun t -> t.all)
      |> seal

    let baking_rights =
      RPC_service.get_service
        ~description:
          "Retrieves the list of delegates allowed to bake a block.\n\
           By default, it gives the best baking priorities for bakers that \
           have at least one opportunity below the 64th priority for the next \
           block.\n\
           Parameters `level` and `cycle` can be used to specify the (valid) \
           level(s) in the past or future at which the baking rights have to \
           be returned. Parameter `delegate` can be used to restrict the \
           results to the given delegates. If parameter `all` is set, all the \
           baking opportunities for each baker at each level are returned, \
           instead of just the first one.\n\
           Returns the list of baking slots. Also returns the minimal \
           timestamps that correspond to these slots. The timestamps are \
           omitted for levels in the past, and are only estimates for levels \
           later that the next block, based on the hypothesis that all \
           predecessor blocks were baked at the first priority."
        ~query:baking_rights_query
        ~output:(list encoding)
        custom_root
  end

  let baking_priorities ctxt max_prio (level, pred_timestamp) =
    Baking.baking_priorities ctxt level
    >>=? fun contract_list ->
    let rec loop l acc priority =
      if Compare.Int.(priority >= max_prio) then return (List.rev acc)
      else
        let (Misc.LCons (pk, next)) = l in
        let delegate = Signature.Public_key.hash pk in
        ( match pred_timestamp with
        | None ->
            return_none
        | Some pred_timestamp ->
            Baking.minimal_time ctxt priority pred_timestamp
            >>=? fun t -> return_some t )
        >>=? fun timestamp ->
        let acc =
          {level = level.level; delegate; priority; timestamp} :: acc
        in
        next () >>=? fun l -> loop l acc (priority + 1)
    in
    loop contract_list [] 0

  let remove_duplicated_delegates rights =
    List.rev @@ fst
    @@ List.fold_left
         (fun (acc, previous) r ->
           if Signature.Public_key_hash.Set.mem r.delegate previous then
             (acc, previous)
           else
             (r :: acc, Signature.Public_key_hash.Set.add r.delegate previous))
         ([], Signature.Public_key_hash.Set.empty)
         rights

  let register () =
    let open Services_registration in
    register0 S.baking_rights (fun ctxt q () ->
        requested_levels
          ~default:
            ( Level.succ ctxt (Level.current ctxt),
              Some (Timestamp.current ctxt) )
          ctxt
          q.cycles
          q.levels
        >>=? fun levels ->
        let max_priority =
          match q.max_priority with None -> 64 | Some max -> max
        in
        map_s (baking_priorities ctxt max_priority) levels
        >>=? fun rights ->
        let rights =
          if q.all then rights else List.map remove_duplicated_delegates rights
        in
        let rights = List.concat rights in
        match q.delegates with
        | [] ->
            return rights
        | _ :: _ as delegates ->
            let is_requested p =
              List.exists
                (Signature.Public_key_hash.equal p.delegate)
                delegates
            in
            return (List.filter is_requested rights))

  let get ctxt ?(levels = []) ?(cycles = []) ?(delegates = []) ?(all = false)
      ?max_priority block =
    RPC_context.make_call0
      S.baking_rights
      ctxt
      block
      {levels; cycles; delegates; max_priority; all}
      ()
end

module Endorsing_rights = struct
  type t = {
    level : Raw_level.t;
    delegate : Signature.Public_key_hash.t;
    slots : int list;
    estimated_time : Time.t option;
  }

  let encoding =
    let open Data_encoding in
    conv
      (fun {level; delegate; slots; estimated_time} ->
        (level, delegate, slots, estimated_time))
      (fun (level, delegate, slots, estimated_time) ->
        {level; delegate; slots; estimated_time})
      (obj4
         (req "level" Raw_level.encoding)
         (req "delegate" Signature.Public_key_hash.encoding)
         (req "slots" (list uint16))
         (opt "estimated_time" Timestamp.encoding))

  module S = struct
    open Data_encoding

    let custom_root = RPC_path.(open_root / "helpers" / "endorsing_rights")

    type endorsing_rights_query = {
      levels : Raw_level.t list;
      cycles : Cycle.t list;
      delegates : Signature.Public_key_hash.t list;
    }

    let endorsing_rights_query =
      let open RPC_query in
      query (fun levels cycles delegates -> {levels; cycles; delegates})
      |+ multi_field "level" Raw_level.rpc_arg (fun t -> t.levels)
      |+ multi_field "cycle" Cycle.rpc_arg (fun t -> t.cycles)
      |+ multi_field "delegate" Signature.Public_key_hash.rpc_arg (fun t ->
             t.delegates)
      |> seal

    let endorsing_rights =
      RPC_service.get_service
        ~description:
          "Retrieves the delegates allowed to endorse a block.\n\
           By default, it gives the endorsement slots for delegates that have \
           at least one in the next block.\n\
           Parameters `level` and `cycle` can be used to specify the (valid) \
           level(s) in the past or future at which the endorsement rights \
           have to be returned. Parameter `delegate` can be used to restrict \
           the results to the given delegates.\n\
           Returns the list of endorsement slots. Also returns the minimal \
           timestamps that correspond to these slots. The timestamps are \
           omitted for levels in the past, and are only estimates for levels \
           later that the next block, based on the hypothesis that all \
           predecessor blocks were baked at the first priority."
        ~query:endorsing_rights_query
        ~output:(list encoding)
        custom_root
  end

  let endorsement_slots ctxt (level, estimated_time) =
    Baking.endorsement_rights ctxt level
    >>=? fun rights ->
    return
      (Signature.Public_key_hash.Map.fold
         (fun delegate (_, slots, _) acc ->
           {level = level.level; delegate; slots; estimated_time} :: acc)
         rights
         [])

  let register () =
    let open Services_registration in
    register0 S.endorsing_rights (fun ctxt q () ->
        requested_levels
          ~default:(Level.current ctxt, Some (Timestamp.current ctxt))
          ctxt
          q.cycles
          q.levels
        >>=? fun levels ->
        map_s (endorsement_slots ctxt) levels
        >>=? fun rights ->
        let rights = List.concat rights in
        match q.delegates with
        | [] ->
            return rights
        | _ :: _ as delegates ->
            let is_requested p =
              List.exists
                (Signature.Public_key_hash.equal p.delegate)
                delegates
            in
            return (List.filter is_requested rights))

  let get ctxt ?(levels = []) ?(cycles = []) ?(delegates = []) block =
    RPC_context.make_call0
      S.endorsing_rights
      ctxt
      block
      {levels; cycles; delegates}
      ()
end

module Endorsing_power = struct
  let endorsing_power ctxt (operation, chain_id) =
    let (Operation_data data) = operation.protocol_data in
    match data.contents with
    | Single (Endorsement _) ->
        Baking.check_endorsement_rights
          ctxt
          chain_id
          {shell = operation.shell; protocol_data = data}
        >>=? fun (_, slots, _) -> return (List.length slots)
    | _ ->
        failwith "Operation is not an endorsement"

  module S = struct
    let endorsing_power =
      let open Data_encoding in
      RPC_service.post_service
        ~description:
          "Get the endorsing power of an endorsement, that is, the number of \
           slots that the endorser has"
        ~query:RPC_query.empty
        ~input:
          (obj2
             (req "endorsement_operation" Operation.encoding)
             (req "chain_id" Chain_id.encoding))
        ~output:int31
        RPC_path.(open_root / "endorsing_power")
  end

  let register () =
    let open Services_registration in
    register0 S.endorsing_power (fun ctxt () (op, chain_id) ->
        endorsing_power ctxt (op, chain_id))

  let get ctxt block op chain_id =
    RPC_context.make_call0 S.endorsing_power ctxt block () (op, chain_id)
end

module Required_endorsements = struct
  let required_endorsements ctxt block_delay =
    return (Baking.minimum_allowed_endorsements ctxt ~block_delay)

  module S = struct
    type t = {block_delay : Period.t}

    let required_endorsements_query =
      let open RPC_query in
      query (fun block_delay -> {block_delay})
      |+ field "block_delay" Period.rpc_arg Period.zero (fun t ->
             t.block_delay)
      |> seal

    let required_endorsements =
      let open Data_encoding in
      RPC_service.get_service
        ~description:
          "Minimum number of endorsements for a block to be valid, given a \
           delay of the block's timestamp with respect to the minimum time to \
           bake at the block's priority"
        ~query:required_endorsements_query
        ~output:int31
        RPC_path.(open_root / "required_endorsements")
  end

  let register () =
    let open Services_registration in
    register0 S.required_endorsements (fun ctxt {block_delay} () ->
        required_endorsements ctxt block_delay)

  let get ctxt block block_delay =
    RPC_context.make_call0 S.required_endorsements ctxt block {block_delay} ()
end

module Minimal_valid_time = struct
  let minimal_valid_time ctxt ~priority ~endorsing_power =
    Baking.minimal_valid_time ctxt ~priority ~endorsing_power

  module S = struct
    type t = {priority : int; endorsing_power : int}

    let minimal_valid_time_query =
      let open RPC_query in
      query (fun priority endorsing_power -> {priority; endorsing_power})
      |+ field "priority" RPC_arg.int 0 (fun t -> t.priority)
      |+ field "endorsing_power" RPC_arg.int 0 (fun t -> t.endorsing_power)
      |> seal

    let minimal_valid_time =
      RPC_service.get_service
        ~description:
          "Minimal valid time for a block given a priority and an endorsing \
           power."
        ~query:minimal_valid_time_query
        ~output:Time.encoding
        RPC_path.(open_root / "minimal_valid_time")
  end

  let register () =
    let open Services_registration in
    register0 S.minimal_valid_time (fun ctxt {priority; endorsing_power} () ->
        minimal_valid_time ctxt ~priority ~endorsing_power)

  let get ctxt block priority endorsing_power =
    RPC_context.make_call0
      S.minimal_valid_time
      ctxt
      block
      {priority; endorsing_power}
      ()
end

let register () =
  register () ;
  Baking_rights.register () ;
  Endorsing_rights.register () ;
  Endorsing_power.register () ;
  Required_endorsements.register () ;
  Minimal_valid_time.register ()

let endorsement_rights ctxt level =
  Endorsing_rights.endorsement_slots ctxt (level, None)
  >>=? fun l ->
  return (List.map (fun {Endorsing_rights.delegate; _} -> delegate) l)

let baking_rights ctxt max_priority =
  let max = match max_priority with None -> 64 | Some m -> m in
  let level = Level.current ctxt in
  Baking_rights.baking_priorities ctxt max (level, None)
  >>=? fun l ->
  return
    ( level.level,
      List.map
        (fun {Baking_rights.delegate; timestamp; _} -> (delegate, timestamp))
        l )

let endorsing_power ctxt operation =
  Endorsing_power.endorsing_power ctxt operation

let required_endorsements ctxt delay =
  Required_endorsements.required_endorsements ctxt delay

let minimal_valid_time ctxt priority endorsing_power =
  Minimal_valid_time.minimal_valid_time ctxt priority endorsing_power
delegate_services_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Record info := {
  balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
  frozen_balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
  frozen_balance_by_cycle :
    Tezos_raw_protocol_alpha.Alpha_context.Cycle.Map.t
      Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance;
  staking_balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
  delegated_contracts : list Tezos_raw_protocol_alpha.Contract_repr.t;
  delegated_balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
  deactivated : bool;
  grace_period : Tezos_raw_protocol_alpha.Alpha_context.Cycle.t }.

Definition info_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding info :=
  conv
    (fun function_parameter =>
      let '{|
        balance := balance;
          frozen_balance := frozen_balance;
          frozen_balance_by_cycle := frozen_balance_by_cycle;
          staking_balance := staking_balance;
          delegated_contracts := delegated_contracts;
          delegated_balance := delegated_balance;
          deactivated := deactivated;
          grace_period := grace_period
          |} := function_parameter in
      (balance, frozen_balance, frozen_balance_by_cycle, staking_balance,
        delegated_contracts, delegated_balance, deactivated, grace_period))
    (fun function_parameter =>
      let
        '(balance, frozen_balance, frozen_balance_by_cycle, staking_balance,
          delegated_contracts, delegated_balance, deactivated, grace_period) :=
        function_parameter in
      {| balance := balance; frozen_balance := frozen_balance;
        frozen_balance_by_cycle := frozen_balance_by_cycle;
        staking_balance := staking_balance;
        delegated_contracts := delegated_contracts;
        delegated_balance := delegated_balance; deactivated := deactivated;
        grace_period := grace_period |}) None
    (obj8 (req None None "balance" % string Tez.encoding)
      (req None None "frozen_balance" % string Tez.encoding)
      (req None None "frozen_balance_by_cycle" % string
        Delegate.frozen_balance_by_cycle_encoding)
      (req None None "staking_balance" % string Tez.encoding)
      (req None None "delegated_contracts" % string
        (list None Contract_repr.encoding))
      (req None None "delegated_balance" % string Tez.encoding)
      (req None None "deactivated" % string bool)
      (req None None "grace_period" % string Cycle.encoding)).

Module S.
  Definition path
    : Tezos_protocol_environment_alpha__Environment.RPC_path.path
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context :=
    op_div (op_div open_root "context" % string) "delegates" % string.
  
  Import Data_encoding.
  
  Record list_query := {
    active : bool;
    inactive : bool }.
  
  Definition list_query
    : Tezos_protocol_environment_alpha__Environment.RPC_query.t list_query :=
    op_pipegt
      (op_pipeplus
        (op_pipeplus
          (query
            (fun active =>
              fun inactive => {| active := active; inactive := inactive |}))
          (flag None "active" % string (fun t => active t)))
        (flag None "inactive" % string (fun t => inactive t))) seal.
  
  Definition list_delegate
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      list_query unit
      (list
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t) :=
    RPC_service.get_service (Some "Lists all registered delegates." % string)
      list_query (list None Signature.Public_key_hash.encoding) path.
  
  Definition path
    : Tezos_protocol_environment_alpha__Environment.RPC_path.path
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t) :=
    op_divcolon path Signature.Public_key_hash.rpc_arg.
  
  Definition info
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      unit unit info :=
    RPC_service.get_service (Some "Everything about a delegate." % string)
      RPC_query.empty info_encoding path.
  
  Definition balance
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      unit unit Tezos_raw_protocol_alpha.Alpha_context.Tez.t :=
    RPC_service.get_service
      (Some
        "Returns the full balance of a given delegate, including the frozen balances."
          % string) RPC_query.empty Tez.encoding
      (op_div path "balance" % string).
  
  Definition frozen_balance
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      unit unit Tezos_raw_protocol_alpha.Alpha_context.Tez.t :=
    RPC_service.get_service
      (Some
        "Returns the total frozen balances of a given delegate, this includes the frozen deposits, rewards and fees."
          % string) RPC_query.empty Tez.encoding
      (op_div path "frozen_balance" % string).
  
  Definition frozen_balance_by_cycle
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      unit unit
      (Tezos_raw_protocol_alpha__Alpha_context.Cycle.Map.(Tezos_protocol_environment_alpha__Environment.MAP.S.t)
        Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance) :=
    RPC_service.get_service
      (Some
        "Returns the frozen balances of a given delegate, indexed by the cycle by which it will be unfrozen"
          % string) RPC_query.empty Delegate.frozen_balance_by_cycle_encoding
      (op_div path "frozen_balance_by_cycle" % string).
  
  Definition staking_balance
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      unit unit Tezos_raw_protocol_alpha.Alpha_context.Tez.t :=
    RPC_service.get_service
      (Some
        "Returns the total amount of tokens delegated to a given delegate. This includes the balances of all the contracts that delegate to it, but also the balance of the delegate itself and its frozen fees and deposits. The rewards do not count in the delegated balance until they are unfrozen."
          % string) RPC_query.empty Tez.encoding
      (op_div path "staking_balance" % string).
  
  Definition delegated_contracts
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      unit unit (list Tezos_raw_protocol_alpha.Contract_repr.contract) :=
    RPC_service.get_service
      (Some
        "Returns the list of contracts that delegate to a given delegate." %
          string) RPC_query.empty (list None Contract_repr.encoding)
      (op_div path "delegated_contracts" % string).
  
  Definition delegated_balance
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      unit unit Tezos_raw_protocol_alpha.Alpha_context.Tez.t :=
    RPC_service.get_service
      (Some
        "Returns the balances of all the contracts that delegate to a given delegate. This excludes the delegate's own balance and its frozen balances."
          % string) RPC_query.empty Tez.encoding
      (op_div path "delegated_balance" % string).
  
  Definition deactivated
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      unit unit bool :=
    RPC_service.get_service
      (Some
        "Tells whether the delegate is currently tagged as deactivated or not."
          % string) RPC_query.empty bool (op_div path "deactivated" % string).
  
  Definition grace_period
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context *
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      unit unit Tezos_raw_protocol_alpha.Alpha_context.Cycle.t :=
    RPC_service.get_service
      (Some
        "Returns the cycle by the end of which the delegate might be deactivated if she fails to execute any delegate action. A deactivated delegate might be reactivated (without loosing any rolls) by simply re-registering as a delegate. For deactivated delegates, this value contains the cycle by which they were deactivated."
          % string) RPC_query.empty Cycle.encoding
      (op_div path "grace_period" % string).
End S.

Definition register (function_parameter : unit) : unit :=
  let 'tt := function_parameter in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register0 S.list_delegate
      (fun ctxt =>
        fun q =>
          fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteq (Delegate.list ctxt)
              (fun delegates =>
                if op_andand (active q) (inactive q) then
                  __return delegates
                else
                  if active q then
                    filter_map_s
                      (fun pkh =>
                        op_gtgteqquestion (Delegate.deactivated ctxt pkh)
                          (fun function_parameter =>
                            match function_parameter with
                            | true => return_none
                            | false => return_some pkh
                            end)) delegates
                  else
                    if inactive q then
                      filter_map_s
                        (fun pkh =>
                          op_gtgteqquestion (Delegate.deactivated ctxt pkh)
                            (fun function_parameter =>
                              match function_parameter with
                              | false => return_none
                              | true => return_some pkh
                              end)) delegates
                    else
                      return_nil)) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.info
      (fun ctxt =>
        fun pkh =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteqquestion (Delegate.full_balance ctxt pkh)
                (fun balance =>
                  op_gtgteqquestion (Delegate.frozen_balance ctxt pkh)
                    (fun frozen_balance =>
                      op_gtgteq (Delegate.frozen_balance_by_cycle ctxt pkh)
                        (fun frozen_balance_by_cycle =>
                          op_gtgteqquestion (Delegate.staking_balance ctxt pkh)
                            (fun staking_balance =>
                              op_gtgteq (Delegate.delegated_contracts ctxt pkh)
                                (fun delegated_contracts =>
                                  op_gtgteqquestion
                                    (Delegate.delegated_balance ctxt pkh)
                                    (fun delegated_balance =>
                                      op_gtgteqquestion
                                        (Delegate.deactivated ctxt pkh)
                                        (fun deactivated =>
                                          op_gtgteqquestion
                                            (Delegate.grace_period ctxt pkh)
                                            (fun grace_period =>
                                              __return
                                                {| balance := balance;
                                                  frozen_balance :=
                                                    frozen_balance;
                                                  frozen_balance_by_cycle :=
                                                    frozen_balance_by_cycle;
                                                  staking_balance :=
                                                    staking_balance;
                                                  delegated_contracts :=
                                                    delegated_contracts;
                                                  delegated_balance :=
                                                    delegated_balance;
                                                  deactivated := deactivated;
                                                  grace_period := grace_period
                                                  |}))))))))) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.balance
      (fun ctxt =>
        fun pkh =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              Delegate.full_balance ctxt pkh) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.frozen_balance
      (fun ctxt =>
        fun pkh =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              Delegate.frozen_balance ctxt pkh) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.frozen_balance_by_cycle
      (fun ctxt =>
        fun pkh =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteq (Delegate.frozen_balance_by_cycle ctxt pkh) __return) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.staking_balance
      (fun ctxt =>
        fun pkh =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              Delegate.staking_balance ctxt pkh) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.delegated_contracts
      (fun ctxt =>
        fun pkh =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteq (Delegate.delegated_contracts ctxt pkh) __return) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.delegated_balance
      (fun ctxt =>
        fun pkh =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              Delegate.delegated_balance ctxt pkh) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register1 S.deactivated
      (fun ctxt =>
        fun pkh =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let 'tt := function_parameter in
              Delegate.deactivated ctxt pkh) in
  register1 S.grace_period
    (fun ctxt =>
      fun pkh =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            Delegate.grace_period ctxt pkh).

Definition list {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D) (op_staroptstar : option bool)
  : option bool ->
    unit ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          (list
            Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)) :=
  let active :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => true
    end in
  fun op_staroptstar =>
    let inactive :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => false
      end in
    fun function_parameter =>
      let 'tt := function_parameter in
      RPC_context.make_call0 S.list_delegate ctxt block
        {| active := active; inactive := inactive |} tt.

Definition info {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  (pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      info) := RPC_context.make_call1 S.info ctxt block pkh tt tt.

Definition balance {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  (pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t) :=
  RPC_context.make_call1 S.balance ctxt block pkh tt tt.

Definition frozen_balance {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  (pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t) :=
  RPC_context.make_call1 S.frozen_balance ctxt block pkh tt tt.

Definition frozen_balance_by_cycle {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  (pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (Tezos_raw_protocol_alpha__Alpha_context.Cycle.Map.(Tezos_protocol_environment_alpha__Environment.MAP.S.t)
        Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance)) :=
  RPC_context.make_call1 S.frozen_balance_by_cycle ctxt block pkh tt tt.

Definition staking_balance {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  (pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t) :=
  RPC_context.make_call1 S.staking_balance ctxt block pkh tt tt.

Definition delegated_contracts {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  (pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (list Tezos_raw_protocol_alpha.Contract_repr.contract)) :=
  RPC_context.make_call1 S.delegated_contracts ctxt block pkh tt tt.

Definition delegated_balance {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  (pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Tez.t) :=
  RPC_context.make_call1 S.delegated_balance ctxt block pkh tt tt.

Definition deactivated {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  (pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      bool) := RPC_context.make_call1 S.deactivated ctxt block pkh tt tt.

Definition grace_period {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  (pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Cycle.t) :=
  RPC_context.make_call1 S.grace_period ctxt block pkh tt tt.

Definition requested_levels
  (default :
    Tezos_raw_protocol_alpha.Alpha_context.Level.t *
      option Tezos_raw_protocol_alpha.Alpha_context.Timestamp.t)
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (cycles : list Tezos_raw_protocol_alpha__Alpha_context.Cycle.t)
  (levels : list Tezos_raw_protocol_alpha__Alpha_context.Raw_level.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list
        (Tezos_raw_protocol_alpha.Alpha_context.Level.t *
          option Tezos_raw_protocol_alpha.Alpha_context.Timestamp.t))) :=
  match (levels, cycles) with
  | ([], []) => __return (cons default [])
  | (levels, cycles) =>
    let levels :=
      List.sort_uniq Level.compare
        (List.concat
          (cons
            (List.map
              (let arg := Level.from_raw ctxt in
              fun eta => arg None eta) levels)
            (List.map (Level.levels_in_cycle ctxt) cycles))) in
    map_s
      (fun level =>
        let current_level := Level.current ctxt in
        if op_lteq level current_level then
          __return (level, None)
        else
          op_gtgteqquestion (Baking.earlier_predecessor_timestamp ctxt level)
            (fun timestamp => __return (level, (Some timestamp)))) levels
  end.

Module Baking_rights.
  Record t := {
    level : Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t;
    delegate :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
    priority : Z;
    timestamp : option Tezos_raw_protocol_alpha.Alpha_context.Timestamp.t }.
  
  Definition encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
    conv
      (fun function_parameter =>
        let '{|
          level := level;
            delegate := delegate;
            priority := priority;
            timestamp := timestamp
            |} := function_parameter in
        (level, delegate, priority, timestamp))
      (fun function_parameter =>
        let '(level, delegate, priority, timestamp) := function_parameter in
        {| level := level; delegate := delegate; priority := priority;
          timestamp := timestamp |}) None
      (obj4 (req None None "level" % string Raw_level.encoding)
        (req None None "delegate" % string Signature.Public_key_hash.encoding)
        (req None None "priority" % string uint16)
        (opt None None "estimated_time" % string Timestamp.encoding)).
  
  Module S.
    Import Data_encoding.
    
    Definition custom_root
      : Tezos_protocol_environment_alpha__Environment.RPC_path.path
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context :=
      op_div (op_div open_root "helpers" % string) "baking_rights" % string.
    
    Record baking_rights_query := {
      levels : list Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t;
      cycles : list Tezos_raw_protocol_alpha.Alpha_context.Cycle.t;
      delegates :
        list
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
      max_priority : option Z;
      all : bool }.
    
    Definition baking_rights_query
      : Tezos_protocol_environment_alpha__Environment.RPC_query.t
        baking_rights_query :=
      op_pipegt
        (op_pipeplus
          (op_pipeplus
            (op_pipeplus
              (op_pipeplus
                (op_pipeplus
                  (query
                    (fun levels =>
                      fun cycles =>
                        fun delegates =>
                          fun max_priority =>
                            fun all =>
                              {| levels := levels; cycles := cycles;
                                delegates := delegates;
                                max_priority := max_priority; all := all |}))
                  (multi_field None "level" % string Raw_level.rpc_arg
                    (fun t => levels t)))
                (multi_field None "cycle" % string Cycle.rpc_arg
                  (fun t => cycles t)))
              (multi_field None "delegate" % string
                Signature.Public_key_hash.rpc_arg (fun t => delegates t)))
            (opt_field None "max_priority" % string RPC_arg.int
              (fun t => max_priority t)))
          (flag None "all" % string (fun t => all t))) seal.
    
    Definition baking_rights
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        variant
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        baking_rights_query unit (list t) :=
      RPC_service.get_service
        (Some
          "Retrieves the list of delegates allowed to bake a block.
By default, it gives the best baking priorities for bakers that have at least one opportunity below the 64th priority for the next block.
Parameters `level` and `cycle` can be used to specify the (valid) level(s) in the past or future at which the baking rights have to be returned. Parameter `delegate` can be used to restrict the results to the given delegates. If parameter `all` is set, all the baking opportunities for each baker at each level are returned, instead of just the first one.
Returns the list of baking slots. Also returns the minimal timestamps that correspond to these slots. The timestamps are omitted for levels in the past, and are only estimates for levels later that the next block, based on the hypothesis that all predecessor blocks were baked at the first priority."
            % string) baking_rights_query (list None encoding) custom_root.
  End S.
  
  Definition baking_priorities
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
    (max_prio :
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
    (function_parameter :
      Tezos_raw_protocol_alpha.Alpha_context.Level.t *
        option Tezos_protocol_environment_alpha__Environment.Time.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (list t)) :=
    let '(level, pred_timestamp) := function_parameter in
    op_gtgteqquestion (Baking.baking_priorities ctxt level)
      (fun contract_list =>
        let fix loop
          (l :
          Tezos_raw_protocol_alpha.Misc.lazy_list_t
            Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
          (acc : list t) (priority :
          Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
          : Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (list t)) :=
          if
            Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
              priority max_prio then
            __return (List.rev acc)
          else
            let 'Tezos_raw_protocol_alpha.Misc.LCons pk next := l in
            let delegate := Signature.Public_key.hash pk in
            op_gtgteqquestion
              match pred_timestamp with
              | None => return_none
              | Some pred_timestamp =>
                op_gtgteqquestion
                  (Baking.minimal_time ctxt priority pred_timestamp)
                  (fun t => return_some t)
              end
              (fun timestamp =>
                let acc :=
                  cons
                    {| level := level level; delegate := delegate;
                      priority := priority; timestamp := timestamp |} acc in
                op_gtgteqquestion (next tt)
                  (fun l => loop l acc (op_plus priority 1))) in
        loop contract_list [] 0).
  
  Definition remove_duplicated_delegates (rights : list t) : list t :=
    op_atat List.rev
      (op_atat fst
        (List.fold_left
          (fun function_parameter =>
            let '(acc, previous) := function_parameter in
            fun r =>
              if Signature.Public_key_hash.Set.mem (delegate r) previous then
                (acc, previous)
              else
                ((cons r acc),
                  (Signature.Public_key_hash.Set.add (delegate r) previous)))
          ([], Signature.Public_key_hash.Set.empty) rights)).
  
  Definition register (function_parameter : unit) : unit :=
    let 'tt := function_parameter in
    register0 S.baking_rights
      (fun ctxt =>
        fun q =>
          fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (requested_levels
                ((Level.succ ctxt (Level.current ctxt)),
                  (Some (Timestamp.current ctxt))) ctxt (cycles q) (levels q))
              (fun levels =>
                let max_priority :=
                  match max_priority q with
                  | None => 64
                  | Some max => max
                  end in
                op_gtgteqquestion
                  (map_s (baking_priorities ctxt max_priority) levels)
                  (fun rights =>
                    let rights :=
                      if all q then
                        rights
                      else
                        List.map remove_duplicated_delegates rights in
                    let rights := List.concat rights in
                    match delegates q with
                    | [] => __return rights
                    | (cons _ _) as delegates =>
                      let is_requested (p : t) : bool :=
                        List.__exists
                          (Signature.Public_key_hash.equal (delegate p))
                          delegates in
                      __return (List.filter is_requested rights)
                    end))).
  
  Definition get {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (op_staroptstar :
      option (list Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t))
    : option (list Tezos_raw_protocol_alpha.Alpha_context.Cycle.t) ->
      option
        (list
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
        ->
        option bool ->
          option Z ->
            D ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  (list t)) :=
    let levels :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => []
      end in
    fun op_staroptstar =>
      let cycles :=
        match op_staroptstar with
        | Some op_starsthstar => op_starsthstar
        | None => []
        end in
      fun op_staroptstar =>
        let delegates :=
          match op_staroptstar with
          | Some op_starsthstar => op_starsthstar
          | None => []
          end in
        fun op_staroptstar =>
          let all :=
            match op_staroptstar with
            | Some op_starsthstar => op_starsthstar
            | None => false
            end in
          fun max_priority =>
            fun block =>
              RPC_context.make_call0 S.baking_rights ctxt block
                {| levels := levels; cycles := cycles; delegates := delegates;
                  max_priority := max_priority; all := all |} tt.
End Baking_rights.

Module Endorsing_rights.
  Record t := {
    level : Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t;
    delegate :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
    slots : list Z;
    estimated_time : option Tezos_protocol_environment_alpha__Environment.Time.t
    }.
  
  Definition encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
    conv
      (fun function_parameter =>
        let '{|
          level := level;
            delegate := delegate;
            slots := slots;
            estimated_time := estimated_time
            |} := function_parameter in
        (level, delegate, slots, estimated_time))
      (fun function_parameter =>
        let '(level, delegate, slots, estimated_time) := function_parameter in
        {| level := level; delegate := delegate; slots := slots;
          estimated_time := estimated_time |}) None
      (obj4 (req None None "level" % string Raw_level.encoding)
        (req None None "delegate" % string Signature.Public_key_hash.encoding)
        (req None None "slots" % string (list None uint16))
        (opt None None "estimated_time" % string Timestamp.encoding)).
  
  Module S.
    Import Data_encoding.
    
    Definition custom_root
      : Tezos_protocol_environment_alpha__Environment.RPC_path.path
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context :=
      op_div (op_div open_root "helpers" % string) "endorsing_rights" % string.
    
    Record endorsing_rights_query := {
      levels : list Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t;
      cycles : list Tezos_raw_protocol_alpha.Alpha_context.Cycle.t;
      delegates :
        list
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
      }.
    
    Definition endorsing_rights_query
      : Tezos_protocol_environment_alpha__Environment.RPC_query.t
        endorsing_rights_query :=
      op_pipegt
        (op_pipeplus
          (op_pipeplus
            (op_pipeplus
              (query
                (fun levels =>
                  fun cycles =>
                    fun delegates =>
                      {| levels := levels; cycles := cycles;
                        delegates := delegates |}))
              (multi_field None "level" % string Raw_level.rpc_arg
                (fun t => levels t)))
            (multi_field None "cycle" % string Cycle.rpc_arg (fun t => cycles t)))
          (multi_field None "delegate" % string
            Signature.Public_key_hash.rpc_arg (fun t => delegates t))) seal.
    
    Definition endorsing_rights
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        variant
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        endorsing_rights_query unit (list t) :=
      RPC_service.get_service
        (Some
          "Retrieves the delegates allowed to endorse a block.
By default, it gives the endorsement slots for delegates that have at least one in the next block.
Parameters `level` and `cycle` can be used to specify the (valid) level(s) in the past or future at which the endorsement rights have to be returned. Parameter `delegate` can be used to restrict the results to the given delegates.
Returns the list of endorsement slots. Also returns the minimal timestamps that correspond to these slots. The timestamps are omitted for levels in the past, and are only estimates for levels later that the next block, based on the hypothesis that all predecessor blocks were baked at the first priority."
            % string) endorsing_rights_query (list None encoding) custom_root.
  End S.
  
  Definition endorsement_slots
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
    (function_parameter :
      Tezos_raw_protocol_alpha.Alpha_context.Level.t *
        option Tezos_protocol_environment_alpha__Environment.Time.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (list t)) :=
    let '(level, estimated_time) := function_parameter in
    op_gtgteqquestion (Baking.endorsement_rights ctxt level)
      (fun rights =>
        __return
          (Signature.Public_key_hash.Map.fold
            (fun delegate =>
              fun function_parameter =>
                let '(_, slots, _) := function_parameter in
                fun acc =>
                  cons
                    {| level := level level; delegate := delegate;
                      slots := slots; estimated_time := estimated_time |} acc)
            rights [])).
  
  Definition register (function_parameter : unit) : unit :=
    let 'tt := function_parameter in
    register0 S.endorsing_rights
      (fun ctxt =>
        fun q =>
          fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (requested_levels
                ((Level.current ctxt), (Some (Timestamp.current ctxt))) ctxt
                (cycles q) (levels q))
              (fun levels =>
                op_gtgteqquestion (map_s (endorsement_slots ctxt) levels)
                  (fun rights =>
                    let rights := List.concat rights in
                    match delegates q with
                    | [] => __return rights
                    | (cons _ _) as delegates =>
                      let is_requested (p : t) : bool :=
                        List.__exists
                          (Signature.Public_key_hash.equal (delegate p))
                          delegates in
                      __return (List.filter is_requested rights)
                    end))).
  
  Definition get {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (op_staroptstar :
      option (list Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t))
    : option (list Tezos_raw_protocol_alpha.Alpha_context.Cycle.t) ->
      option
        (list
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
        ->
        D ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              (list t)) :=
    let levels :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => []
      end in
    fun op_staroptstar =>
      let cycles :=
        match op_staroptstar with
        | Some op_starsthstar => op_starsthstar
        | None => []
        end in
      fun op_staroptstar =>
        let delegates :=
          match op_staroptstar with
          | Some op_starsthstar => op_starsthstar
          | None => []
          end in
        fun block =>
          RPC_context.make_call0 S.endorsing_rights ctxt block
            {| levels := levels; cycles := cycles; delegates := delegates |} tt.
End Endorsing_rights.

Module Endorsing_power.
  Definition endorsing_power
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
    (function_parameter :
      Tezos_raw_protocol_alpha.Alpha_context.packed_operation *
        Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z) :=
    let '(operation, chain_id) := function_parameter in
    let 'Tezos_raw_protocol_alpha.Alpha_context.Operation_data data :=
      protocol_data operation in
    match contents data with
    |
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Endorsement _) =>
      op_gtgteqquestion
        (Baking.check_endorsement_rights ctxt chain_id
          {| shell := shell operation; protocol_data := data |})
        (fun function_parameter =>
          let '(_, slots, _) := function_parameter in
          __return (List.length slots))
    | _ => failwith "Operation is not an endorsement" % string
    end.
  
  Module S.
    Definition endorsing_power
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        variant
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (Tezos_raw_protocol_alpha.Alpha_context.Operation.packed *
          Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
        Z :=
      RPC_service.post_service
        (Some
          "Get the endorsing power of an endorsement, that is, the number of slots that the endorser has"
            % string) RPC_query.empty
        (obj2
          (req None None "endorsement_operation" % string Operation.encoding)
          (req None None "chain_id" % string
            Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.encoding)))
        int31 (op_div open_root "endorsing_power" % string).
  End S.
  
  Definition register (function_parameter : unit) : unit :=
    let 'tt := function_parameter in
    register0 S.endorsing_power
      (fun ctxt =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let '(op, chain_id) := function_parameter in
            endorsing_power ctxt (op, chain_id)).
  
  Definition get {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (block : D) (op : Tezos_raw_protocol_alpha.Alpha_context.Operation.packed)
    (chain_id :
      Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Z) :=
    RPC_context.make_call0 S.endorsing_power ctxt block tt (op, chain_id).
End Endorsing_power.

Module Required_endorsements.
  Definition required_endorsements
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
    (block_delay : Tezos_raw_protocol_alpha.Alpha_context.Period.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z) :=
    __return (Baking.minimum_allowed_endorsements ctxt block_delay).
  
  Module S.
    Record t := {
      block_delay : Tezos_raw_protocol_alpha.Alpha_context.Period.t }.
    
    Definition required_endorsements_query
      : Tezos_protocol_environment_alpha__Environment.RPC_query.t t :=
      op_pipegt
        (op_pipeplus
          (query (fun block_delay => {| block_delay := block_delay |}))
          (field None "block_delay" % string Period.rpc_arg Period.zero
            (fun t => block_delay t))) seal.
    
    Definition required_endorsements
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        variant
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context t unit
        Z :=
      RPC_service.get_service
        (Some
          "Minimum number of endorsements for a block to be valid, given a delay of the block's timestamp with respect to the minimum time to bake at the block's priority"
            % string) required_endorsements_query int31
        (op_div open_root "required_endorsements" % string).
  End S.
  
  Definition register (function_parameter : unit) : unit :=
    let 'tt := function_parameter in
    register0 S.required_endorsements
      (fun ctxt =>
        fun function_parameter =>
          let '{| block_delay := block_delay |} := function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            required_endorsements ctxt block_delay).
  
  Definition get {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (block : D) (block_delay : Tezos_raw_protocol_alpha.Alpha_context.Period.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Z) :=
    RPC_context.make_call0 S.required_endorsements ctxt block
      {| block_delay := block_delay |} tt.
End Required_endorsements.

Module Minimal_valid_time.
  Definition minimal_valid_time
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (priority : Z)
    (endorsing_power : Z)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_protocol_environment_alpha__Environment.Time.t) :=
    Baking.minimal_valid_time ctxt priority endorsing_power.
  
  Module S.
    Record t := {
      priority : Z;
      endorsing_power : Z }.
    
    Definition minimal_valid_time_query
      : Tezos_protocol_environment_alpha__Environment.RPC_query.t t :=
      op_pipegt
        (op_pipeplus
          (op_pipeplus
            (query
              (fun priority =>
                fun endorsing_power =>
                  {| priority := priority; endorsing_power := endorsing_power |}))
            (field None "priority" % string RPC_arg.int 0 (fun t => priority t)))
          (field None "endorsing_power" % string RPC_arg.int 0
            (fun t => endorsing_power t))) seal.
    
    Definition minimal_valid_time
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        variant
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context t unit
        Tezos_protocol_environment_alpha__Environment.Time.t :=
      RPC_service.get_service
        (Some
          "Minimal valid time for a block given a priority and an endorsing power."
            % string) minimal_valid_time_query Time.encoding
        (op_div open_root "minimal_valid_time" % string).
  End S.
  
  Definition register (function_parameter : unit) : unit :=
    let 'tt := function_parameter in
    register0 S.minimal_valid_time
      (fun ctxt =>
        fun function_parameter =>
          let '{| priority := priority; endorsing_power := endorsing_power |} :=
            function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            minimal_valid_time ctxt priority endorsing_power).
  
  Definition get {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (block : D) (priority : Z) (endorsing_power : Z)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.Time.t) :=
    RPC_context.make_call0 S.minimal_valid_time ctxt block
      {| priority := priority; endorsing_power := endorsing_power |} tt.
End Minimal_valid_time.

Definition register (function_parameter : unit) : unit :=
  let 'tt := function_parameter in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Baking_rights.register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Endorsing_rights.register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Endorsing_power.register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Required_endorsements.register tt in
  Minimal_valid_time.register tt.

Definition endorsement_rights
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (level : Tezos_raw_protocol_alpha.Alpha_context.Level.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)) :=
  op_gtgteqquestion (Endorsing_rights.endorsement_slots ctxt (level, None))
    (fun l =>
      __return
        (List.map
          (fun function_parameter =>
            let '{| Endorsing_rights.delegate := delegate |} :=
              function_parameter in
            delegate) l)).

Definition baking_rights
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (max_priority :
    option
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha__Alpha_context.Raw_level.t *
        list
          (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
            * option Tezos_raw_protocol_alpha.Alpha_context.Timestamp.t))) :=
  let max :=
    match max_priority with
    | None => 64
    | Some m => m
    end in
  let level := Level.current ctxt in
  op_gtgteqquestion (Baking_rights.baking_priorities ctxt max (level, None))
    (fun l =>
      __return
        ((level level),
          (List.map
            (fun function_parameter =>
              let '{|
                Baking_rights.delegate := delegate;
                  Baking_rights.timestamp := timestamp
                  |} := function_parameter in
              (delegate, timestamp)) l))).

Definition endorsing_power
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (operation :
    Tezos_raw_protocol_alpha.Alpha_context.packed_operation *
      Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z) :=
  Endorsing_power.endorsing_power ctxt operation.

Definition required_endorsements
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (delay : Tezos_raw_protocol_alpha.Alpha_context.Period.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z) :=
  Required_endorsements.required_endorsements ctxt delay.

Definition minimal_valid_time
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (priority : Z)
  (endorsing_power : Z)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Time.t) :=
  Minimal_valid_time.minimal_valid_time ctxt priority endorsing_power.
delegate_services.mli 288 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

val list :
  'a #RPC_context.simple ->
  'a ->
  ?active:bool ->
  ?inactive:bool ->
  unit ->
  Signature.Public_key_hash.t list shell_tzresult Lwt.t

type info = {
  balance : Tez.t;
  frozen_balance : Tez.t;
  frozen_balance_by_cycle : Delegate.frozen_balance Cycle.Map.t;
  staking_balance : Tez.t;
  delegated_contracts : Contract_repr.t list;
  delegated_balance : Tez.t;
  deactivated : bool;
  grace_period : Cycle.t;
}

val info_encoding : info Data_encoding.t

val info :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  info shell_tzresult Lwt.t

val balance :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  Tez.t shell_tzresult Lwt.t

val frozen_balance :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  Tez.t shell_tzresult Lwt.t

val frozen_balance_by_cycle :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  Delegate.frozen_balance Cycle.Map.t shell_tzresult Lwt.t

val staking_balance :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  Tez.t shell_tzresult Lwt.t

val delegated_contracts :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  Contract_repr.t list shell_tzresult Lwt.t

val delegated_balance :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  Tez.t shell_tzresult Lwt.t

val deactivated :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  bool shell_tzresult Lwt.t

val grace_period :
  'a #RPC_context.simple ->
  'a ->
  Signature.Public_key_hash.t ->
  Cycle.t shell_tzresult Lwt.t

module Baking_rights : sig
  type t = {
    level : Raw_level.t;
    delegate : Signature.Public_key_hash.t;
    priority : int;
    timestamp : Timestamp.t option;
  }

  (** Retrieves the list of delegates allowed to bake a block.

      By default, it gives the best baking priorities for bakers
      that have at least one opportunity below the 64th priority for
      the next block.

      Parameters [levels] and [cycles] can be used to specify the
      (valid) level(s) in the past or future at which the baking rights
      have to be returned. Parameter [delegates] can be used to
      restrict the results to the given delegates. If parameter [all]
      is [true], all the baking opportunities for each baker at each level
      are returned, instead of just the first one.

      Returns the list of baking slots. Also returns the minimal
      timestamps that correspond to these slots. The timestamps are
      omitted for levels in the past, and are only estimates for levels
      later that the next block, based on the hypothesis that all
      predecessor blocks were baked at the first priority. *)
  val get :
    'a #RPC_context.simple ->
    ?levels:Raw_level.t list ->
    ?cycles:Cycle.t list ->
    ?delegates:Signature.public_key_hash list ->
    ?all:bool ->
    ?max_priority:int ->
    'a ->
    t list shell_tzresult Lwt.t
end

module Endorsing_rights : sig
  type t = {
    level : Raw_level.t;
    delegate : Signature.Public_key_hash.t;
    slots : int list;
    estimated_time : Timestamp.t option;
  }

  (** Retrieves the delegates allowed to endorse a block.

      By default, it gives the endorsement slots for bakers that have
      at least one in the next block.

      Parameters [levels] and [cycles] can be used to specify the
      (valid) level(s) in the past or future at which the endorsement
      rights have to be returned. Parameter [delegates] can be used to
      restrict the results to the given delegates.  Returns the list of
      endorsement slots. Also returns the minimal timestamps that
      correspond to these slots.

      Timestamps are omitted for levels in the past, and are only
      estimates for levels later that the next block, based on the
      hypothesis that all predecessor blocks were baked at the first
      priority. *)
  val get :
    'a #RPC_context.simple ->
    ?levels:Raw_level.t list ->
    ?cycles:Cycle.t list ->
    ?delegates:Signature.public_key_hash list ->
    'a ->
    t list shell_tzresult Lwt.t
end

module Endorsing_power : sig
  val get :
    'a #RPC_context.simple ->
    'a ->
    Alpha_context.packed_operation ->
    Chain_id.t ->
    int shell_tzresult Lwt.t
end

module Required_endorsements : sig
  val get :
    'a #RPC_context.simple -> 'a -> Period.t -> int shell_tzresult Lwt.t
end

module Minimal_valid_time : sig
  val get :
    'a #RPC_context.simple -> 'a -> int -> int -> Time.t shell_tzresult Lwt.t
end

(* temporary export for deprecated unit test *)
val endorsement_rights :
  Alpha_context.t -> Level.t -> public_key_hash list tzresult Lwt.t

val baking_rights :
  Alpha_context.t ->
  int option ->
  (Raw_level.t * (public_key_hash * Time.t option) list) tzresult Lwt.t

val endorsing_power :
  Alpha_context.t ->
  Alpha_context.packed_operation * Chain_id.t ->
  int tzresult Lwt.t

val required_endorsements :
  Alpha_context.t -> Alpha_context.Period.t -> int tzresult Lwt.t

val minimal_valid_time : Alpha_context.t -> int -> int -> Time.t tzresult Lwt.t

val register : unit -> unit
delegate_services_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter list : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    option bool ->
      option bool ->
        unit ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              (list
                Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)).

Record info := {
  balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
  frozen_balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
  frozen_balance_by_cycle :
    Tezos_raw_protocol_alpha.Alpha_context.Cycle.Map.t
      Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance;
  staking_balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
  delegated_contracts : list Tezos_raw_protocol_alpha.Contract_repr.t;
  delegated_balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
  deactivated : bool;
  grace_period : Tezos_raw_protocol_alpha.Alpha_context.Cycle.t }.

Parameter info_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t info.

Parameter info : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          info).

Parameter balance : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          Tezos_raw_protocol_alpha.Alpha_context.Tez.t).

Parameter frozen_balance : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          Tezos_raw_protocol_alpha.Alpha_context.Tez.t).

Parameter frozen_balance_by_cycle : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          (Tezos_raw_protocol_alpha.Alpha_context.Cycle.Map.t
            Tezos_raw_protocol_alpha.Alpha_context.Delegate.frozen_balance)).

Parameter staking_balance : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          Tezos_raw_protocol_alpha.Alpha_context.Tez.t).

Parameter delegated_contracts : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          (list Tezos_raw_protocol_alpha.Contract_repr.t)).

Parameter delegated_balance : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          Tezos_raw_protocol_alpha.Alpha_context.Tez.t).

Parameter deactivated : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          bool).

Parameter grace_period : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          Tezos_raw_protocol_alpha.Alpha_context.Cycle.t).

Module Baking_rights.
  Record t := {
    level : Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t;
    delegate :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
    priority : Z;
    timestamp : option Tezos_raw_protocol_alpha.Alpha_context.Timestamp.t }.
  
  Parameter get : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    option (list Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t) ->
      option (list Tezos_raw_protocol_alpha.Alpha_context.Cycle.t) ->
        option
          (list
            Tezos_protocol_environment_alpha__Environment.Signature.public_key_hash)
          ->
          option bool ->
            option Z ->
              a ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    (list t)).
End Baking_rights.

Module Endorsing_rights.
  Record t := {
    level : Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t;
    delegate :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
    slots : list Z;
    estimated_time : option Tezos_raw_protocol_alpha.Alpha_context.Timestamp.t
    }.
  
  Parameter get : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    option (list Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t) ->
      option (list Tezos_raw_protocol_alpha.Alpha_context.Cycle.t) ->
        option
          (list
            Tezos_protocol_environment_alpha__Environment.Signature.public_key_hash)
          ->
          a ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                (list t)).
End Endorsing_rights.

Module Endorsing_power.
  Parameter get : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      Tezos_raw_protocol_alpha.Alpha_context.packed_operation ->
        Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
          ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              Z).
End Endorsing_power.

Module Required_endorsements.
  Parameter get : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      Tezos_raw_protocol_alpha.Alpha_context.Period.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            Z).
End Required_endorsements.

Module Minimal_valid_time.
  Parameter get : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      Z ->
        Z ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              Tezos_protocol_environment_alpha__Environment.Time.t).
End Minimal_valid_time.

Parameter endorsement_rights :
Tezos_raw_protocol_alpha.Alpha_context.t ->
  Tezos_raw_protocol_alpha.Alpha_context.Level.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (list Tezos_raw_protocol_alpha.Alpha_context.public_key_hash)).

Parameter baking_rights :
Tezos_raw_protocol_alpha.Alpha_context.t ->
  option Z ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t *
          list
            (Tezos_raw_protocol_alpha.Alpha_context.public_key_hash *
              option Tezos_protocol_environment_alpha__Environment.Time.t))).

Parameter endorsing_power :
Tezos_raw_protocol_alpha.Alpha_context.t ->
  Tezos_raw_protocol_alpha.Alpha_context.packed_operation *
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
    ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z).

Parameter required_endorsements :
Tezos_raw_protocol_alpha.Alpha_context.t ->
  Tezos_raw_protocol_alpha.Alpha_context.Period.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z).

Parameter minimal_valid_time :
Tezos_raw_protocol_alpha.Alpha_context.t ->
  Z ->
    Z ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_protocol_environment_alpha__Environment.Time.t).

Parameter register : unit -> unit.
delegate_storage.ml 16 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type balance =
  | Contract of Contract_repr.t
  | Rewards of Signature.Public_key_hash.t * Cycle_repr.t
  | Fees of Signature.Public_key_hash.t * Cycle_repr.t
  | Deposits of Signature.Public_key_hash.t * Cycle_repr.t

let balance_encoding =
  let open Data_encoding in
  def "operation_metadata.alpha.balance"
  @@ union
       [ case
           (Tag 0)
           ~title:"Contract"
           (obj2
              (req "kind" (constant "contract"))
              (req "contract" Contract_repr.encoding))
           (function Contract c -> Some ((), c) | _ -> None)
           (fun ((), c) -> Contract c);
         case
           (Tag 1)
           ~title:"Rewards"
           (obj4
              (req "kind" (constant "freezer"))
              (req "category" (constant "rewards"))
              (req "delegate" Signature.Public_key_hash.encoding)
              (req "cycle" Cycle_repr.encoding))
           (function Rewards (d, l) -> Some ((), (), d, l) | _ -> None)
           (fun ((), (), d, l) -> Rewards (d, l));
         case
           (Tag 2)
           ~title:"Fees"
           (obj4
              (req "kind" (constant "freezer"))
              (req "category" (constant "fees"))
              (req "delegate" Signature.Public_key_hash.encoding)
              (req "cycle" Cycle_repr.encoding))
           (function Fees (d, l) -> Some ((), (), d, l) | _ -> None)
           (fun ((), (), d, l) -> Fees (d, l));
         case
           (Tag 3)
           ~title:"Deposits"
           (obj4
              (req "kind" (constant "freezer"))
              (req "category" (constant "deposits"))
              (req "delegate" Signature.Public_key_hash.encoding)
              (req "cycle" Cycle_repr.encoding))
           (function Deposits (d, l) -> Some ((), (), d, l) | _ -> None)
           (fun ((), (), d, l) -> Deposits (d, l)) ]

type balance_update = Debited of Tez_repr.t | Credited of Tez_repr.t

let balance_update_encoding =
  let open Data_encoding in
  def "operation_metadata.alpha.balance_update"
  @@ obj1
       (req
          "change"
          (conv
             (function
               | Credited v ->
                   Tez_repr.to_mutez v
               | Debited v ->
                   Int64.neg (Tez_repr.to_mutez v))
             ( Json.wrap_error
             @@ fun v ->
             if Compare.Int64.(v < 0L) then
               match Tez_repr.of_mutez (Int64.neg v) with
               | Some v ->
                   Debited v
               | None ->
                   failwith "Qty.of_mutez"
             else
               match Tez_repr.of_mutez v with
               | Some v ->
                   Credited v
               | None ->
                   failwith "Qty.of_mutez" )
             int64))

type balance_updates = (balance * balance_update) list

let balance_updates_encoding =
  let open Data_encoding in
  def "operation_metadata.alpha.balance_updates"
  @@ list (merge_objs balance_encoding balance_update_encoding)

let cleanup_balance_updates balance_updates =
  List.filter
    (fun (_, (Credited update | Debited update)) ->
      not (Tez_repr.equal update Tez_repr.zero))
    balance_updates

type frozen_balance = {
  deposit : Tez_repr.t;
  fees : Tez_repr.t;
  rewards : Tez_repr.t;
}

let frozen_balance_encoding =
  let open Data_encoding in
  conv
    (fun {deposit; fees; rewards} -> (deposit, fees, rewards))
    (fun (deposit, fees, rewards) -> {deposit; fees; rewards})
    (obj3
       (req "deposit" Tez_repr.encoding)
       (req "fees" Tez_repr.encoding)
       (req "rewards" Tez_repr.encoding))

type error +=
  | No_deletion of Signature.Public_key_hash.t (* `Permanent *)
  | Active_delegate (* `Temporary *)
  | Current_delegate (* `Temporary *)
  | Empty_delegate_account of Signature.Public_key_hash.t (* `Temporary *)
  | Balance_too_low_for_deposit of {
      delegate : Signature.Public_key_hash.t;
      deposit : Tez_repr.t;
      balance : Tez_repr.t;
    }

(* `Temporary *)

let () =
  register_error_kind
    `Permanent
    ~id:"delegate.no_deletion"
    ~title:"Forbidden delegate deletion"
    ~description:"Tried to unregister a delegate"
    ~pp:(fun ppf delegate ->
      Format.fprintf
        ppf
        "Delegate deletion is forbidden (%a)"
        Signature.Public_key_hash.pp
        delegate)
    Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding))
    (function No_deletion c -> Some c | _ -> None)
    (fun c -> No_deletion c) ;
  register_error_kind
    `Temporary
    ~id:"delegate.already_active"
    ~title:"Delegate already active"
    ~description:"Useless delegate reactivation"
    ~pp:(fun ppf () ->
      Format.fprintf ppf "The delegate is still active, no need to refresh it")
    Data_encoding.empty
    (function Active_delegate -> Some () | _ -> None)
    (fun () -> Active_delegate) ;
  register_error_kind
    `Temporary
    ~id:"delegate.unchanged"
    ~title:"Unchanged delegated"
    ~description:"Contract already delegated to the given delegate"
    ~pp:(fun ppf () ->
      Format.fprintf
        ppf
        "The contract is already delegated to the same delegate")
    Data_encoding.empty
    (function Current_delegate -> Some () | _ -> None)
    (fun () -> Current_delegate) ;
  register_error_kind
    `Permanent
    ~id:"delegate.empty_delegate_account"
    ~title:"Empty delegate account"
    ~description:
      "Cannot register a delegate when its implicit account is empty"
    ~pp:(fun ppf delegate ->
      Format.fprintf
        ppf
        "Delegate registration is forbidden when the delegate\n\
        \           implicit account is empty (%a)"
        Signature.Public_key_hash.pp
        delegate)
    Data_encoding.(obj1 (req "delegate" Signature.Public_key_hash.encoding))
    (function Empty_delegate_account c -> Some c | _ -> None)
    (fun c -> Empty_delegate_account c) ;
  register_error_kind
    `Temporary
    ~id:"delegate.balance_too_low_for_deposit"
    ~title:"Balance too low for deposit"
    ~description:"Cannot freeze deposit when the balance is too low"
    ~pp:(fun ppf (delegate, balance, deposit) ->
      Format.fprintf
        ppf
        "Delegate %a has a too low balance (%a) to deposit %a"
        Signature.Public_key_hash.pp
        delegate
        Tez_repr.pp
        balance
        Tez_repr.pp
        deposit)
    Data_encoding.(
      obj3
        (req "delegate" Signature.Public_key_hash.encoding)
        (req "balance" Tez_repr.encoding)
        (req "deposit" Tez_repr.encoding))
    (function
      | Balance_too_low_for_deposit {delegate; balance; deposit} ->
          Some (delegate, balance, deposit)
      | _ ->
          None)
    (fun (delegate, balance, deposit) ->
      Balance_too_low_for_deposit {delegate; balance; deposit})

let link c contract delegate =
  Storage.Contract.Balance.get c contract
  >>=? fun balance ->
  Roll_storage.Delegate.add_amount c delegate balance
  >>=? fun c ->
  Storage.Contract.Delegated.add
    (c, Contract_repr.implicit_contract delegate)
    contract
  >>= fun c -> return c

let unlink c contract =
  Storage.Contract.Balance.get c contract
  >>=? fun balance ->
  Storage.Contract.Delegate.get_option c contract
  >>=? function
  | None ->
      return c
  | Some delegate ->
      (* Removes the balance of the contract from the delegate *)
      Roll_storage.Delegate.remove_amount c delegate balance
      >>=? fun c ->
      Storage.Contract.Delegated.del
        (c, Contract_repr.implicit_contract delegate)
        contract
      >>= fun c -> return c

let known c delegate =
  Storage.Contract.Manager.get_option
    c
    (Contract_repr.implicit_contract delegate)
  >>=? function
  | None | Some (Manager_repr.Hash _) ->
      return_false
  | Some (Manager_repr.Public_key _) ->
      return_true

(* A delegate is registered if its "implicit account" delegates to itself. *)
let registered c delegate =
  Storage.Contract.Delegate.get_option
    c
    (Contract_repr.implicit_contract delegate)
  >>=? function
  | Some current_delegate ->
      return @@ Signature.Public_key_hash.equal delegate current_delegate
  | None ->
      return_false

let init ctxt contract delegate =
  known ctxt delegate
  >>=? fun known_delegate ->
  fail_unless known_delegate (Roll_storage.Unregistered_delegate delegate)
  >>=? fun () ->
  registered ctxt delegate
  >>=? fun is_registered ->
  fail_unless is_registered (Roll_storage.Unregistered_delegate delegate)
  >>=? fun () ->
  Storage.Contract.Delegate.init ctxt contract delegate
  >>=? fun ctxt -> link ctxt contract delegate

let get = Roll_storage.get_contract_delegate

let set c contract delegate =
  match delegate with
  | None -> (
      let delete () =
        unlink c contract
        >>=? fun c ->
        Storage.Contract.Delegate.remove c contract >>= fun c -> return c
      in
      match Contract_repr.is_implicit contract with
      | Some pkh ->
          (* check if contract is a registered delegate *)
          registered c pkh
          >>=? fun is_registered ->
          if is_registered then fail (No_deletion pkh) else delete ()
      | None ->
          delete () )
  | Some delegate ->
      known c delegate
      >>=? fun known_delegate ->
      registered c delegate
      >>=? fun registered_delegate ->
      let self_delegation =
        match Contract_repr.is_implicit contract with
        | Some pkh ->
            Signature.Public_key_hash.equal pkh delegate
        | None ->
            false
      in
      if (not known_delegate) || not (registered_delegate || self_delegation)
      then fail (Roll_storage.Unregistered_delegate delegate)
      else
        Storage.Contract.Delegate.get_option c contract
        >>=? (function
               | Some current_delegate
                 when Signature.Public_key_hash.equal delegate current_delegate
                 ->
                   if self_delegation then
                     Roll_storage.Delegate.is_inactive c delegate
                     >>=? function
                     | true -> return_unit | false -> fail Active_delegate
                   else fail Current_delegate
               | None | Some _ ->
                   return_unit)
        >>=? fun () ->
        (* check if contract is a registered delegate *)
        ( match Contract_repr.is_implicit contract with
        | Some pkh ->
            registered c pkh
            >>=? fun is_registered ->
            (* allow self-delegation to re-activate *)
            if (not self_delegation) && is_registered then
              fail (No_deletion pkh)
            else return_unit
        | None ->
            return_unit )
        >>=? fun () ->
        Storage.Contract.Balance.mem c contract
        >>= fun exists ->
        fail_when
          (self_delegation && not exists)
          (Empty_delegate_account delegate)
        >>=? fun () ->
        unlink c contract
        >>=? fun c ->
        Storage.Contract.Delegate.init_set c contract delegate
        >>= fun c ->
        link c contract delegate
        >>=? fun c ->
        ( if self_delegation then
          Storage.Delegates.add c delegate
          >>= fun c ->
          Roll_storage.Delegate.set_active c delegate >>=? fun c -> return c
        else return c )
        >>=? fun c -> return c

let remove ctxt contract = unlink ctxt contract

let delegated_contracts ctxt delegate =
  let contract = Contract_repr.implicit_contract delegate in
  Storage.Contract.Delegated.elements (ctxt, contract)

let get_frozen_deposit ctxt contract cycle =
  Storage.Contract.Frozen_deposits.get_option (ctxt, contract) cycle
  >>=? function None -> return Tez_repr.zero | Some frozen -> return frozen

let credit_frozen_deposit ctxt delegate cycle amount =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_deposit ctxt contract cycle
  >>=? fun old_amount ->
  Lwt.return Tez_repr.(old_amount +? amount)
  >>=? fun new_amount ->
  Storage.Contract.Frozen_deposits.init_set (ctxt, contract) cycle new_amount
  >>= fun ctxt ->
  Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate
  >>= fun ctxt -> return ctxt

let freeze_deposit ctxt delegate amount =
  let {Level_repr.cycle; _} = Level_storage.current ctxt in
  Roll_storage.Delegate.set_active ctxt delegate
  >>=? fun ctxt ->
  let contract = Contract_repr.implicit_contract delegate in
  Storage.Contract.Balance.get ctxt contract
  >>=? fun balance ->
  Lwt.return
    (record_trace
       (Balance_too_low_for_deposit {delegate; deposit = amount; balance})
       Tez_repr.(balance -? amount))
  >>=? fun new_balance ->
  Storage.Contract.Balance.set ctxt contract new_balance
  >>=? fun ctxt -> credit_frozen_deposit ctxt delegate cycle amount

let get_frozen_fees ctxt contract cycle =
  Storage.Contract.Frozen_fees.get_option (ctxt, contract) cycle
  >>=? function None -> return Tez_repr.zero | Some frozen -> return frozen

let credit_frozen_fees ctxt delegate cycle amount =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_fees ctxt contract cycle
  >>=? fun old_amount ->
  Lwt.return Tez_repr.(old_amount +? amount)
  >>=? fun new_amount ->
  Storage.Contract.Frozen_fees.init_set (ctxt, contract) cycle new_amount
  >>= fun ctxt ->
  Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate
  >>= fun ctxt -> return ctxt

let freeze_fees ctxt delegate amount =
  let {Level_repr.cycle; _} = Level_storage.current ctxt in
  Roll_storage.Delegate.add_amount ctxt delegate amount
  >>=? fun ctxt -> credit_frozen_fees ctxt delegate cycle amount

let burn_fees ctxt delegate cycle amount =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_fees ctxt contract cycle
  >>=? fun old_amount ->
  ( match Tez_repr.(old_amount -? amount) with
  | Ok new_amount ->
      Roll_storage.Delegate.remove_amount ctxt delegate amount
      >>=? fun ctxt -> return (new_amount, ctxt)
  | Error _ ->
      Roll_storage.Delegate.remove_amount ctxt delegate old_amount
      >>=? fun ctxt -> return (Tez_repr.zero, ctxt) )
  >>=? fun (new_amount, ctxt) ->
  Storage.Contract.Frozen_fees.init_set (ctxt, contract) cycle new_amount
  >>= fun ctxt -> return ctxt

let get_frozen_rewards ctxt contract cycle =
  Storage.Contract.Frozen_rewards.get_option (ctxt, contract) cycle
  >>=? function None -> return Tez_repr.zero | Some frozen -> return frozen

let credit_frozen_rewards ctxt delegate cycle amount =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_rewards ctxt contract cycle
  >>=? fun old_amount ->
  Lwt.return Tez_repr.(old_amount +? amount)
  >>=? fun new_amount ->
  Storage.Contract.Frozen_rewards.init_set (ctxt, contract) cycle new_amount
  >>= fun ctxt ->
  Storage.Delegates_with_frozen_balance.add (ctxt, cycle) delegate
  >>= fun ctxt -> return ctxt

let freeze_rewards ctxt delegate amount =
  let {Level_repr.cycle; _} = Level_storage.current ctxt in
  credit_frozen_rewards ctxt delegate cycle amount

let burn_rewards ctxt delegate cycle amount =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_rewards ctxt contract cycle
  >>=? fun old_amount ->
  let new_amount =
    match Tez_repr.(old_amount -? amount) with
    | Error _ ->
        Tez_repr.zero
    | Ok new_amount ->
        new_amount
  in
  Storage.Contract.Frozen_rewards.init_set (ctxt, contract) cycle new_amount
  >>= fun ctxt -> return ctxt

let unfreeze ctxt delegate cycle =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_deposit ctxt contract cycle
  >>=? fun deposit ->
  get_frozen_fees ctxt contract cycle
  >>=? fun fees ->
  get_frozen_rewards ctxt contract cycle
  >>=? fun rewards ->
  Storage.Contract.Balance.get ctxt contract
  >>=? fun balance ->
  Lwt.return Tez_repr.(deposit +? fees)
  >>=? fun unfrozen_amount ->
  Lwt.return Tez_repr.(unfrozen_amount +? rewards)
  >>=? fun unfrozen_amount ->
  Lwt.return Tez_repr.(balance +? unfrozen_amount)
  >>=? fun balance ->
  Storage.Contract.Balance.set ctxt contract balance
  >>=? fun ctxt ->
  Roll_storage.Delegate.add_amount ctxt delegate rewards
  >>=? fun ctxt ->
  Storage.Contract.Frozen_deposits.remove (ctxt, contract) cycle
  >>= fun ctxt ->
  Storage.Contract.Frozen_fees.remove (ctxt, contract) cycle
  >>= fun ctxt ->
  Storage.Contract.Frozen_rewards.remove (ctxt, contract) cycle
  >>= fun ctxt ->
  return
    ( ctxt,
      cleanup_balance_updates
        [ (Deposits (delegate, cycle), Debited deposit);
          (Fees (delegate, cycle), Debited fees);
          (Rewards (delegate, cycle), Debited rewards);
          ( Contract (Contract_repr.implicit_contract delegate),
            Credited unfrozen_amount ) ] )

let cycle_end ctxt last_cycle unrevealed =
  let preserved = Constants_storage.preserved_cycles ctxt in
  ( match Cycle_repr.pred last_cycle with
  | None ->
      return (ctxt, [])
  | Some revealed_cycle ->
      List.fold_left
        (fun acc (u : Nonce_storage.unrevealed) ->
          acc
          >>=? fun (ctxt, balance_updates) ->
          burn_fees ctxt u.delegate revealed_cycle u.fees
          >>=? fun ctxt ->
          burn_rewards ctxt u.delegate revealed_cycle u.rewards
          >>=? fun ctxt ->
          let bus =
            [ (Fees (u.delegate, revealed_cycle), Debited u.fees);
              (Rewards (u.delegate, revealed_cycle), Debited u.rewards) ]
          in
          return (ctxt, bus @ balance_updates))
        (return (ctxt, []))
        unrevealed )
  >>=? fun (ctxt, balance_updates) ->
  match Cycle_repr.sub last_cycle preserved with
  | None ->
      return (ctxt, balance_updates, [])
  | Some unfrozen_cycle ->
      Storage.Delegates_with_frozen_balance.fold
        (ctxt, unfrozen_cycle)
        ~init:(Ok (ctxt, balance_updates))
        ~f:(fun delegate acc ->
          Lwt.return acc
          >>=? fun (ctxt, bus) ->
          unfreeze ctxt delegate unfrozen_cycle
          >>=? fun (ctxt, balance_updates) ->
          return (ctxt, balance_updates @ bus))
      >>=? fun (ctxt, balance_updates) ->
      Storage.Delegates_with_frozen_balance.clear (ctxt, unfrozen_cycle)
      >>= fun ctxt ->
      Storage.Active_delegates_with_rolls.fold
        ctxt
        ~init:(Ok (ctxt, []))
        ~f:(fun delegate acc ->
          Lwt.return acc
          >>=? fun (ctxt, deactivated) ->
          Storage.Contract.Delegate_desactivation.get
            ctxt
            (Contract_repr.implicit_contract delegate)
          >>=? fun cycle ->
          if Cycle_repr.(cycle <= last_cycle) then
            Roll_storage.Delegate.set_inactive ctxt delegate
            >>=? fun ctxt -> return (ctxt, delegate :: deactivated)
          else return (ctxt, deactivated))
      >>=? fun (ctxt, deactivated) ->
      return (ctxt, balance_updates, deactivated)

let punish ctxt delegate cycle =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_deposit ctxt contract cycle
  >>=? fun deposit ->
  get_frozen_fees ctxt contract cycle
  >>=? fun fees ->
  get_frozen_rewards ctxt contract cycle
  >>=? fun rewards ->
  Roll_storage.Delegate.remove_amount ctxt delegate deposit
  >>=? fun ctxt ->
  Roll_storage.Delegate.remove_amount ctxt delegate fees
  >>=? fun ctxt ->
  (* Rewards are not accounted in the delegate's rolls yet... *)
  Storage.Contract.Frozen_deposits.remove (ctxt, contract) cycle
  >>= fun ctxt ->
  Storage.Contract.Frozen_fees.remove (ctxt, contract) cycle
  >>= fun ctxt ->
  Storage.Contract.Frozen_rewards.remove (ctxt, contract) cycle
  >>= fun ctxt -> return (ctxt, {deposit; fees; rewards})

let has_frozen_balance ctxt delegate cycle =
  let contract = Contract_repr.implicit_contract delegate in
  get_frozen_deposit ctxt contract cycle
  >>=? fun deposit ->
  if Tez_repr.(deposit <> zero) then return_true
  else
    get_frozen_fees ctxt contract cycle
    >>=? fun fees ->
    if Tez_repr.(fees <> zero) then return_true
    else
      get_frozen_rewards ctxt contract cycle
      >>=? fun rewards -> return Tez_repr.(rewards <> zero)

let frozen_balance_by_cycle_encoding =
  let open Data_encoding in
  conv
    Cycle_repr.Map.bindings
    (List.fold_left
       (fun m (c, b) -> Cycle_repr.Map.add c b m)
       Cycle_repr.Map.empty)
    (list
       (merge_objs
          (obj1 (req "cycle" Cycle_repr.encoding))
          frozen_balance_encoding))

let empty_frozen_balance =
  {deposit = Tez_repr.zero; fees = Tez_repr.zero; rewards = Tez_repr.zero}

let frozen_balance_by_cycle ctxt delegate =
  let contract = Contract_repr.implicit_contract delegate in
  let map = Cycle_repr.Map.empty in
  Storage.Contract.Frozen_deposits.fold
    (ctxt, contract)
    ~init:map
    ~f:(fun cycle amount map ->
      Lwt.return
        (Cycle_repr.Map.add
           cycle
           {empty_frozen_balance with deposit = amount}
           map))
  >>= fun map ->
  Storage.Contract.Frozen_fees.fold
    (ctxt, contract)
    ~init:map
    ~f:(fun cycle amount map ->
      let balance =
        match Cycle_repr.Map.find_opt cycle map with
        | None ->
            empty_frozen_balance
        | Some balance ->
            balance
      in
      Lwt.return (Cycle_repr.Map.add cycle {balance with fees = amount} map))
  >>= fun map ->
  Storage.Contract.Frozen_rewards.fold
    (ctxt, contract)
    ~init:map
    ~f:(fun cycle amount map ->
      let balance =
        match Cycle_repr.Map.find_opt cycle map with
        | None ->
            empty_frozen_balance
        | Some balance ->
            balance
      in
      Lwt.return (Cycle_repr.Map.add cycle {balance with rewards = amount} map))
  >>= fun map -> Lwt.return map

let frozen_balance ctxt delegate =
  let contract = Contract_repr.implicit_contract delegate in
  let balance = Ok Tez_repr.zero in
  Storage.Contract.Frozen_deposits.fold
    (ctxt, contract)
    ~init:balance
    ~f:(fun _cycle amount acc ->
      Lwt.return acc >>=? fun acc -> Lwt.return Tez_repr.(acc +? amount))
  >>= fun balance ->
  Storage.Contract.Frozen_fees.fold
    (ctxt, contract)
    ~init:balance
    ~f:(fun _cycle amount acc ->
      Lwt.return acc >>=? fun acc -> Lwt.return Tez_repr.(acc +? amount))
  >>= fun balance ->
  Storage.Contract.Frozen_rewards.fold
    (ctxt, contract)
    ~init:balance
    ~f:(fun _cycle amount acc ->
      Lwt.return acc >>=? fun acc -> Lwt.return Tez_repr.(acc +? amount))
  >>= fun balance -> Lwt.return balance

let full_balance ctxt delegate =
  let contract = Contract_repr.implicit_contract delegate in
  frozen_balance ctxt delegate
  >>=? fun frozen_balance ->
  Storage.Contract.Balance.get ctxt contract
  >>=? fun balance -> Lwt.return Tez_repr.(frozen_balance +? balance)

let deactivated = Roll_storage.Delegate.is_inactive

let grace_period ctxt delegate =
  let contract = Contract_repr.implicit_contract delegate in
  Storage.Contract.Delegate_desactivation.get ctxt contract

let staking_balance ctxt delegate =
  let token_per_rolls = Constants_storage.tokens_per_roll ctxt in
  Roll_storage.get_rolls ctxt delegate
  >>=? fun rolls ->
  Roll_storage.get_change ctxt delegate
  >>=? fun change ->
  let rolls = Int64.of_int (List.length rolls) in
  Lwt.return Tez_repr.(token_per_rolls *? rolls)
  >>=? fun balance -> Lwt.return Tez_repr.(balance +? change)

let delegated_balance ctxt delegate =
  let contract = Contract_repr.implicit_contract delegate in
  staking_balance ctxt delegate
  >>=? fun staking_balance ->
  Storage.Contract.Balance.get ctxt contract
  >>= fun self_staking_balance ->
  Storage.Contract.Frozen_deposits.fold
    (ctxt, contract)
    ~init:self_staking_balance
    ~f:(fun _cycle amount acc ->
      Lwt.return acc >>=? fun acc -> Lwt.return Tez_repr.(acc +? amount))
  >>= fun self_staking_balance ->
  Storage.Contract.Frozen_fees.fold
    (ctxt, contract)
    ~init:self_staking_balance
    ~f:(fun _cycle amount acc ->
      Lwt.return acc >>=? fun acc -> Lwt.return Tez_repr.(acc +? amount))
  >>=? fun self_staking_balance ->
  Lwt.return Tez_repr.(staking_balance -? self_staking_balance)

let fold = Storage.Delegates.fold

let list = Storage.Delegates.elements
delegate_storage_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive balance : Type :=
| Contract : Tezos_raw_protocol_alpha.Contract_repr.t -> balance
| Rewards :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t -> balance
| Fees :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t -> balance
| Deposits :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t -> balance.

Definition balance_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding balance :=
  op_atat
    (let arg := def "operation_metadata.alpha.balance" % string in
    fun eta => arg None None eta)
    (union None
      (cons
        (case "Contract" % string None
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
          (obj2 (req None None "kind" % string (constant "contract" % string))
            (req None None "contract" % string Contract_repr.encoding))
          (fun function_parameter =>
            match function_parameter with
            | Contract c => Some (tt, c)
            | _ => None
            end)
          (fun function_parameter =>
            let '(tt, c) := function_parameter in
            Contract c))
        (cons
          (case "Rewards" % string None
            (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
            (obj4 (req None None "kind" % string (constant "freezer" % string))
              (req None None "category" % string (constant "rewards" % string))
              (req None None "delegate" % string
                Signature.Public_key_hash.encoding)
              (req None None "cycle" % string Cycle_repr.encoding))
            (fun function_parameter =>
              match function_parameter with
              | Rewards d l => Some (tt, tt, d, l)
              | _ => None
              end)
            (fun function_parameter =>
              let '(tt, tt, d, l) := function_parameter in
              Rewards d l))
          (cons
            (case "Fees" % string None
              (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 2)
              (obj4
                (req None None "kind" % string (constant "freezer" % string))
                (req None None "category" % string (constant "fees" % string))
                (req None None "delegate" % string
                  Signature.Public_key_hash.encoding)
                (req None None "cycle" % string Cycle_repr.encoding))
              (fun function_parameter =>
                match function_parameter with
                | Fees d l => Some (tt, tt, d, l)
                | _ => None
                end)
              (fun function_parameter =>
                let '(tt, tt, d, l) := function_parameter in
                Fees d l))
            (cons
              (case "Deposits" % string None
                (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag
                  3)
                (obj4
                  (req None None "kind" % string (constant "freezer" % string))
                  (req None None "category" % string
                    (constant "deposits" % string))
                  (req None None "delegate" % string
                    Signature.Public_key_hash.encoding)
                  (req None None "cycle" % string Cycle_repr.encoding))
                (fun function_parameter =>
                  match function_parameter with
                  | Deposits d l => Some (tt, tt, d, l)
                  | _ => None
                  end)
                (fun function_parameter =>
                  let '(tt, tt, d, l) := function_parameter in
                  Deposits d l)) []))))).

Inductive balance_update : Type :=
| Debited : Tezos_raw_protocol_alpha.Tez_repr.t -> balance_update
| Credited : Tezos_raw_protocol_alpha.Tez_repr.t -> balance_update.

Definition balance_update_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    balance_update :=
  op_atat
    (let arg := def "operation_metadata.alpha.balance_update" % string in
    fun eta => arg None None eta)
    (obj1
      (req None None "change" % string
        (conv
          (fun function_parameter =>
            match function_parameter with
            | Credited v => Tez_repr.to_mutez v
            | Debited v => Int64.neg (Tez_repr.to_mutez v)
            end)
          (op_atat Json.wrap_error
            (fun v =>
              if
                Tezos_protocol_environment_alpha__Environment.Compare.Int64.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
                  v
                  (* ❌ Constant of type int64 is converted to int *)
                  0 then
                match Tez_repr.of_mutez (Int64.neg v) with
                | Some v => Debited v
                | None => failwith "Qty.of_mutez" % string
                end
              else
                match Tez_repr.of_mutez v with
                | Some v => Credited v
                | None => failwith "Qty.of_mutez" % string
                end)) None int64))).

Definition balance_updates := list (balance * balance_update).

Definition balance_updates_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (list (balance * balance_update)) :=
  op_atat
    (let arg := def "operation_metadata.alpha.balance_updates" % string in
    fun eta => arg None None eta)
    (list None (merge_objs balance_encoding balance_update_encoding)).

Definition cleanup_balance_updates {A : Type}
  (balance_updates : list (A * balance_update)) : list (A * balance_update) :=
  List.filter
    (fun function_parameter =>
      let '(_, Credited update | Debited update) := function_parameter in
      not (Tez_repr.equal update Tez_repr.zero)) balance_updates.

Record frozen_balance := {
  deposit : Tezos_raw_protocol_alpha.Tez_repr.t;
  fees : Tezos_raw_protocol_alpha.Tez_repr.t;
  rewards : Tezos_raw_protocol_alpha.Tez_repr.t }.

Definition frozen_balance_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    frozen_balance :=
  conv
    (fun function_parameter =>
      let '{| deposit := deposit; fees := fees; rewards := rewards |} :=
        function_parameter in
      (deposit, fees, rewards))
    (fun function_parameter =>
      let '(deposit, fees, rewards) := function_parameter in
      {| deposit := deposit; fees := fees; rewards := rewards |}) None
    (obj3 (req None None "deposit" % string Tez_repr.encoding)
      (req None None "fees" % string Tez_repr.encoding)
      (req None None "rewards" % string Tez_repr.encoding)).

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "delegate.no_deletion" % string
      "Forbidden delegate deletion" % string
      "Tried to unregister a delegate" % string
      (Some
        (fun ppf =>
          fun delegate =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Delegate deletion is forbidden (" % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                      ")" % char
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Delegate deletion is forbidden (%a)" % string)
              Signature.Public_key_hash.pp delegate))
      (obj1
        (req None None "delegate" % string Signature.Public_key_hash.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.No_deletion
            c => Some c
        | _ => None
        end)
      (fun c =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.No_deletion c)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "delegate.already_active" % string
      "Delegate already active" % string
      "Useless delegate reactivation" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "The delegate is still active, no need to refresh it" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "The delegate is still active, no need to refresh it" % string)))
      Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Active_delegate
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Active_delegate)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "delegate.unchanged" % string "Unchanged delegated" % string
      "Contract already delegated to the given delegate" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "The contract is already delegated to the same delegate" %
                    string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "The contract is already delegated to the same delegate" %
                  string))) Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Current_delegate
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Current_delegate)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "delegate.empty_delegate_account" % string
      "Empty delegate account" % string
      "Cannot register a delegate when its implicit account is empty" % string
      (Some
        (fun ppf =>
          fun delegate =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Delegate registration is forbidden when the delegate
           implicit account is empty ("
                    % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                      ")" % char
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Delegate registration is forbidden when the delegate
           implicit account is empty (%a)"
                  % string) Signature.Public_key_hash.pp delegate))
      (obj1
        (req None None "delegate" % string Signature.Public_key_hash.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_delegate_account
            c => Some c
        | _ => None
        end)
      (fun c =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_delegate_account
          c) in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "delegate.balance_too_low_for_deposit" % string
    "Balance too low for deposit" % string
    "Cannot freeze deposit when the balance is too low" % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let '(delegate, balance, deposit) := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "Delegate " % string
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    " has a too low balance (" % string
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                        ") to deposit " % string
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))))))
              "Delegate %a has a too low balance (%a) to deposit %a" % string)
            Signature.Public_key_hash.pp delegate Tez_repr.pp balance
            Tez_repr.pp deposit))
    (obj3 (req None None "delegate" % string Signature.Public_key_hash.encoding)
      (req None None "balance" % string Tez_repr.encoding)
      (req None None "deposit" % string Tez_repr.encoding))
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low_for_deposit
          {| delegate := delegate; deposit := deposit; balance := balance |} =>
        Some (delegate, balance, deposit)
      | _ => None
      end)
    (fun function_parameter =>
      let '(delegate, balance, deposit) := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low_for_deposit
        {| delegate := delegate; deposit := deposit; balance := balance |}).

Definition link
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Balance.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Balance.key)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteqquestion (Storage.Contract.Balance.get c contract)
    (fun balance =>
      op_gtgteqquestion (Roll_storage.Delegate.add_amount c delegate balance)
        (fun c =>
          op_gtgteq
            (Storage.Contract.Delegated.add
              (c, (Contract_repr.implicit_contract delegate)) contract)
            (fun c => __return c))).

Definition unlink
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Balance.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Balance.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Contract.Balance.context) :=
  op_gtgteqquestion (Storage.Contract.Balance.get c contract)
    (fun balance =>
      op_gtgteqquestion (Storage.Contract.Delegate.get_option c contract)
        (fun function_parameter =>
          match function_parameter with
          | None => __return c
          | Some delegate =>
            op_gtgteqquestion
              (Roll_storage.Delegate.remove_amount c delegate balance)
              (fun c =>
                op_gtgteq
                  (Storage.Contract.Delegated.del
                    (c, (Contract_repr.implicit_contract delegate)) contract)
                  (fun c => __return c))
          end)).

Definition known
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Manager.context)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool) :=
  op_gtgteqquestion
    (Storage.Contract.Manager.get_option c
      (Contract_repr.implicit_contract delegate))
    (fun function_parameter =>
      match function_parameter with
      | None | Some (Tezos_raw_protocol_alpha.Manager_repr.Hash _) =>
        return_false
      | Some (Tezos_raw_protocol_alpha.Manager_repr.Public_key _) => return_true
      end).

Definition registered
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Delegate.context)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool) :=
  op_gtgteqquestion
    (Storage.Contract.Delegate.get_option c
      (Contract_repr.implicit_contract delegate))
    (fun function_parameter =>
      match function_parameter with
      | Some current_delegate =>
        op_atat __return
          (Signature.Public_key_hash.equal delegate current_delegate)
      | None => return_false
      end).

Definition init
  (ctxt : Tezos_raw_protocol_alpha.Storage.Contract.Manager.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Delegate.key)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteqquestion (known ctxt delegate)
    (fun known_delegate =>
      op_gtgteqquestion
        (fail_unless known_delegate
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Unregistered_delegate
            delegate))
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgteqquestion (registered ctxt delegate)
            (fun is_registered =>
              op_gtgteqquestion
                (fail_unless is_registered
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Unregistered_delegate
                    delegate))
                (fun function_parameter =>
                  let 'tt := function_parameter in
                  op_gtgteqquestion
                    (Storage.Contract.Delegate.init ctxt contract delegate)
                    (fun ctxt => link ctxt contract delegate))))).

Definition get
  : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_raw_protocol_alpha.Contract_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option
            Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)) :=
  Roll_storage.get_contract_delegate.

Definition set
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Balance.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Balance.key)
  (delegate :
    option
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  match delegate with
  | None =>
    let delete (function_parameter : unit)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t) :=
      let 'tt := function_parameter in
      op_gtgteqquestion (unlink c contract)
        (fun c =>
          op_gtgteq (Storage.Contract.Delegate.remove c contract)
            (fun c => __return c)) in
    match Contract_repr.is_implicit contract with
    | Some pkh =>
      op_gtgteqquestion (registered c pkh)
        (fun is_registered =>
          if is_registered then
            fail
              (Tezos_protocol_environment_alpha__Environment.Error_monad.No_deletion
                pkh)
          else
            delete tt)
    | None => delete tt
    end
  | Some delegate =>
    op_gtgteqquestion (known c delegate)
      (fun known_delegate =>
        op_gtgteqquestion (registered c delegate)
          (fun registered_delegate =>
            let self_delegation :=
              match Contract_repr.is_implicit contract with
              | Some pkh => Signature.Public_key_hash.equal pkh delegate
              | None => false
              end in
            if
              op_pipepipe (not known_delegate)
                (not (op_pipepipe registered_delegate self_delegation)) then
              fail
                (Tezos_protocol_environment_alpha__Environment.Error_monad.Unregistered_delegate
                  delegate)
            else
              op_gtgteqquestion
                (op_gtgteqquestion
                  (Storage.Contract.Delegate.get_option c contract)
                  (fun function_parameter =>
                    match function_parameter with
                    | Some current_delegate =>
                      if self_delegation then
                        op_gtgteqquestion
                          (Roll_storage.Delegate.is_inactive c delegate)
                          (fun function_parameter =>
                            match function_parameter with
                            | true => return_unit
                            | false =>
                              fail
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Active_delegate
                            end)
                      else
                        fail
                          Tezos_protocol_environment_alpha__Environment.Error_monad.Current_delegate
                    | None | Some _ => return_unit
                    end))
                (fun function_parameter =>
                  let 'tt := function_parameter in
                  op_gtgteqquestion
                    match Contract_repr.is_implicit contract with
                    | Some pkh =>
                      op_gtgteqquestion (registered c pkh)
                        (fun is_registered =>
                          if op_andand (not self_delegation) is_registered then
                            fail
                              (Tezos_protocol_environment_alpha__Environment.Error_monad.No_deletion
                                pkh)
                          else
                            return_unit)
                    | None => return_unit
                    end
                    (fun function_parameter =>
                      let 'tt := function_parameter in
                      op_gtgteq (Storage.Contract.Balance.mem c contract)
                        (fun __exists =>
                          op_gtgteqquestion
                            (fail_when
                              (op_andand self_delegation (not __exists))
                              (Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_delegate_account
                                delegate))
                            (fun function_parameter =>
                              let 'tt := function_parameter in
                              op_gtgteqquestion (unlink c contract)
                                (fun c =>
                                  op_gtgteq
                                    (Storage.Contract.Delegate.init_set c
                                      contract delegate)
                                    (fun c =>
                                      op_gtgteqquestion
                                        (link c contract delegate)
                                        (fun c =>
                                          op_gtgteqquestion
                                            (if self_delegation then
                                              op_gtgteq
                                                (Storage.Delegates.add c
                                                  delegate)
                                                (fun c =>
                                                  op_gtgteqquestion
                                                    (Roll_storage.Delegate.set_active
                                                      c delegate)
                                                    (fun c => __return c))
                                            else
                                              __return c) (fun c => __return c))))))))))
  end.

Definition remove
  (ctxt : Tezos_raw_protocol_alpha.Storage.Contract.Balance.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Balance.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Contract.Balance.context) :=
  unlink ctxt contract.

Definition delegated_contracts
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (list Tezos_raw_protocol_alpha.Storage.Contract.Delegated.elt) :=
  let contract := Contract_repr.implicit_contract delegate in
  Storage.Contract.Delegated.elements (ctxt, contract).

Definition get_frozen_deposit
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (contract : Tezos_raw_protocol_alpha.Contract_repr.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_deposits.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t) :=
  op_gtgteqquestion
    (Storage.Contract.Frozen_deposits.get_option (ctxt, contract) cycle)
    (fun function_parameter =>
      match function_parameter with
      | None => __return Tez_repr.zero
      | Some frozen => __return frozen
      end).

Definition credit_frozen_deposit
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_deposits.key)
  (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let contract := Contract_repr.implicit_contract delegate in
  op_gtgteqquestion (get_frozen_deposit ctxt contract cycle)
    (fun old_amount =>
      op_gtgteqquestion (Lwt.__return (op_plusquestion old_amount amount))
        (fun new_amount =>
          op_gtgteq
            (Storage.Contract.Frozen_deposits.init_set (ctxt, contract) cycle
              new_amount)
            (fun ctxt =>
              op_gtgteq
                (Storage.Delegates_with_frozen_balance.add (ctxt, cycle)
                  delegate) (fun ctxt => __return ctxt)))).

Definition freeze_deposit
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let '{| Level_repr.cycle := cycle |} := Level_storage.current ctxt in
  op_gtgteqquestion (Roll_storage.Delegate.set_active ctxt delegate)
    (fun ctxt =>
      let contract := Contract_repr.implicit_contract delegate in
      op_gtgteqquestion (Storage.Contract.Balance.get ctxt contract)
        (fun balance =>
          op_gtgteqquestion
            (Lwt.__return
              (record_trace
                (Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low_for_deposit
                  {| delegate := delegate; deposit := amount; balance := balance
                    |}) (op_minusquestion balance amount)))
            (fun new_balance =>
              op_gtgteqquestion
                (Storage.Contract.Balance.set ctxt contract new_balance)
                (fun ctxt => credit_frozen_deposit ctxt delegate cycle amount)))).

Definition get_frozen_fees
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (contract : Tezos_raw_protocol_alpha.Contract_repr.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_fees.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t) :=
  op_gtgteqquestion
    (Storage.Contract.Frozen_fees.get_option (ctxt, contract) cycle)
    (fun function_parameter =>
      match function_parameter with
      | None => __return Tez_repr.zero
      | Some frozen => __return frozen
      end).

Definition credit_frozen_fees
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_fees.key)
  (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let contract := Contract_repr.implicit_contract delegate in
  op_gtgteqquestion (get_frozen_fees ctxt contract cycle)
    (fun old_amount =>
      op_gtgteqquestion (Lwt.__return (op_plusquestion old_amount amount))
        (fun new_amount =>
          op_gtgteq
            (Storage.Contract.Frozen_fees.init_set (ctxt, contract) cycle
              new_amount)
            (fun ctxt =>
              op_gtgteq
                (Storage.Delegates_with_frozen_balance.add (ctxt, cycle)
                  delegate) (fun ctxt => __return ctxt)))).

Definition freeze_fees
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let '{| Level_repr.cycle := cycle |} := Level_storage.current ctxt in
  op_gtgteqquestion (Roll_storage.Delegate.add_amount ctxt delegate amount)
    (fun ctxt => credit_frozen_fees ctxt delegate cycle amount).

Definition burn_fees
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_fees.key)
  (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let contract := Contract_repr.implicit_contract delegate in
  op_gtgteqquestion (get_frozen_fees ctxt contract cycle)
    (fun old_amount =>
      op_gtgteqquestion
        match op_minusquestion old_amount amount with
        | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok new_amount
          =>
          op_gtgteqquestion
            (Roll_storage.Delegate.remove_amount ctxt delegate amount)
            (fun ctxt => __return (new_amount, ctxt))
        | Tezos_protocol_environment_alpha__Environment.Pervasives.Error _ =>
          op_gtgteqquestion
            (Roll_storage.Delegate.remove_amount ctxt delegate old_amount)
            (fun ctxt => __return (Tez_repr.zero, ctxt))
        end
        (fun function_parameter =>
          let '(new_amount, ctxt) := function_parameter in
          op_gtgteq
            (Storage.Contract.Frozen_fees.init_set (ctxt, contract) cycle
              new_amount) (fun ctxt => __return ctxt))).

Definition get_frozen_rewards
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (contract : Tezos_raw_protocol_alpha.Contract_repr.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_rewards.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t) :=
  op_gtgteqquestion
    (Storage.Contract.Frozen_rewards.get_option (ctxt, contract) cycle)
    (fun function_parameter =>
      match function_parameter with
      | None => __return Tez_repr.zero
      | Some frozen => __return frozen
      end).

Definition credit_frozen_rewards
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_rewards.key)
  (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let contract := Contract_repr.implicit_contract delegate in
  op_gtgteqquestion (get_frozen_rewards ctxt contract cycle)
    (fun old_amount =>
      op_gtgteqquestion (Lwt.__return (op_plusquestion old_amount amount))
        (fun new_amount =>
          op_gtgteq
            (Storage.Contract.Frozen_rewards.init_set (ctxt, contract) cycle
              new_amount)
            (fun ctxt =>
              op_gtgteq
                (Storage.Delegates_with_frozen_balance.add (ctxt, cycle)
                  delegate) (fun ctxt => __return ctxt)))).

Definition freeze_rewards
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let '{| Level_repr.cycle := cycle |} := Level_storage.current ctxt in
  credit_frozen_rewards ctxt delegate cycle amount.

Definition burn_rewards
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_rewards.key)
  (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let contract := Contract_repr.implicit_contract delegate in
  op_gtgteqquestion (get_frozen_rewards ctxt contract cycle)
    (fun old_amount =>
      let new_amount :=
        match op_minusquestion old_amount amount with
        | Tezos_protocol_environment_alpha__Environment.Pervasives.Error _ =>
          Tez_repr.zero
        | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok new_amount
          => new_amount
        end in
      op_gtgteq
        (Storage.Contract.Frozen_rewards.init_set (ctxt, contract) cycle
          new_amount) (fun ctxt => __return ctxt)).

Definition unfreeze
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_deposits.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t * list (balance * balance_update))) :=
  let contract := Contract_repr.implicit_contract delegate in
  op_gtgteqquestion (get_frozen_deposit ctxt contract cycle)
    (fun deposit =>
      op_gtgteqquestion (get_frozen_fees ctxt contract cycle)
        (fun fees =>
          op_gtgteqquestion (get_frozen_rewards ctxt contract cycle)
            (fun rewards =>
              op_gtgteqquestion (Storage.Contract.Balance.get ctxt contract)
                (fun balance =>
                  op_gtgteqquestion
                    (Lwt.__return (op_plusquestion deposit fees))
                    (fun unfrozen_amount =>
                      op_gtgteqquestion
                        (Lwt.__return (op_plusquestion unfrozen_amount rewards))
                        (fun unfrozen_amount =>
                          op_gtgteqquestion
                            (Lwt.__return
                              (op_plusquestion balance unfrozen_amount))
                            (fun balance =>
                              op_gtgteqquestion
                                (Storage.Contract.Balance.set ctxt contract
                                  balance)
                                (fun ctxt =>
                                  op_gtgteqquestion
                                    (Roll_storage.Delegate.add_amount ctxt
                                      delegate rewards)
                                    (fun ctxt =>
                                      op_gtgteq
                                        (Storage.Contract.Frozen_deposits.remove
                                          (ctxt, contract) cycle)
                                        (fun ctxt =>
                                          op_gtgteq
                                            (Storage.Contract.Frozen_fees.remove
                                              (ctxt, contract) cycle)
                                            (fun ctxt =>
                                              op_gtgteq
                                                (Storage.Contract.Frozen_rewards.remove
                                                  (ctxt, contract) cycle)
                                                (fun ctxt =>
                                                  __return
                                                    (ctxt,
                                                      (cleanup_balance_updates
                                                        (cons
                                                          ((Deposits delegate
                                                            cycle),
                                                            (Debited deposit))
                                                          (cons
                                                            ((Fees delegate
                                                              cycle),
                                                              (Debited fees))
                                                            (cons
                                                              ((Rewards delegate
                                                                cycle),
                                                                (Debited rewards))
                                                              (cons
                                                                ((Contract
                                                                  (Contract_repr.implicit_contract
                                                                    delegate)),
                                                                  (Credited
                                                                    unfrozen_amount))
                                                                [])))))))))))))))))).

Definition cycle_end
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (last_cycle : Tezos_raw_protocol_alpha.Cycle_repr.cycle)
  (unrevealed : list Tezos_raw_protocol_alpha.Nonce_storage.unrevealed)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.context *
        list (balance * balance_update) *
        list Tezos_raw_protocol_alpha.Storage.Active_delegates_with_rolls.elt)) :=
  let preserved := Constants_storage.preserved_cycles ctxt in
  op_gtgteqquestion
    match Cycle_repr.pred last_cycle with
    | None => __return (ctxt, [])
    | Some revealed_cycle =>
      List.fold_left
        (fun acc =>
          fun u =>
            op_gtgteqquestion acc
              (fun function_parameter =>
                let '(ctxt, balance_updates) := function_parameter in
                op_gtgteqquestion
                  (burn_fees ctxt (delegate u) revealed_cycle (fees u))
                  (fun ctxt =>
                    op_gtgteqquestion
                      (burn_rewards ctxt (delegate u) revealed_cycle (rewards u))
                      (fun ctxt =>
                        let bus :=
                          cons
                            ((Fees (delegate u) revealed_cycle),
                              (Debited (fees u)))
                            (cons
                              ((Rewards (delegate u) revealed_cycle),
                                (Debited (rewards u))) []) in
                        __return (ctxt, (op_at bus balance_updates))))))
        (__return (ctxt, [])) unrevealed
    end
    (fun function_parameter =>
      let '(ctxt, balance_updates) := function_parameter in
      match Cycle_repr.sub last_cycle preserved with
      | None => __return (ctxt, balance_updates, [])
      | Some unfrozen_cycle =>
        op_gtgteqquestion
          (Storage.Delegates_with_frozen_balance.fold (ctxt, unfrozen_cycle)
            (Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
              (ctxt, balance_updates))
            (fun delegate =>
              fun acc =>
                op_gtgteqquestion (Lwt.__return acc)
                  (fun function_parameter =>
                    let '(ctxt, bus) := function_parameter in
                    op_gtgteqquestion (unfreeze ctxt delegate unfrozen_cycle)
                      (fun function_parameter =>
                        let '(ctxt, balance_updates) := function_parameter in
                        __return (ctxt, (op_at balance_updates bus))))))
          (fun function_parameter =>
            let '(ctxt, balance_updates) := function_parameter in
            op_gtgteq
              (Storage.Delegates_with_frozen_balance.clear
                (ctxt, unfrozen_cycle))
              (fun ctxt =>
                op_gtgteqquestion
                  (Storage.Active_delegates_with_rolls.fold ctxt
                    (Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                      (ctxt, []))
                    (fun delegate =>
                      fun acc =>
                        op_gtgteqquestion (Lwt.__return acc)
                          (fun function_parameter =>
                            let '(ctxt, deactivated) := function_parameter in
                            op_gtgteqquestion
                              (Storage.Contract.Delegate_desactivation.get ctxt
                                (Contract_repr.implicit_contract delegate))
                              (fun cycle =>
                                if op_lteq cycle last_cycle then
                                  op_gtgteqquestion
                                    (Roll_storage.Delegate.set_inactive ctxt
                                      delegate)
                                    (fun ctxt =>
                                      __return
                                        (ctxt, (cons delegate deactivated)))
                                else
                                  __return (ctxt, deactivated)))))
                  (fun function_parameter =>
                    let '(ctxt, deactivated) := function_parameter in
                    __return (ctxt, balance_updates, deactivated))))
      end).

Definition punish
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_deposits.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t * frozen_balance)) :=
  let contract := Contract_repr.implicit_contract delegate in
  op_gtgteqquestion (get_frozen_deposit ctxt contract cycle)
    (fun deposit =>
      op_gtgteqquestion (get_frozen_fees ctxt contract cycle)
        (fun fees =>
          op_gtgteqquestion (get_frozen_rewards ctxt contract cycle)
            (fun rewards =>
              op_gtgteqquestion
                (Roll_storage.Delegate.remove_amount ctxt delegate deposit)
                (fun ctxt =>
                  op_gtgteqquestion
                    (Roll_storage.Delegate.remove_amount ctxt delegate fees)
                    (fun ctxt =>
                      op_gtgteq
                        (Storage.Contract.Frozen_deposits.remove
                          (ctxt, contract) cycle)
                        (fun ctxt =>
                          op_gtgteq
                            (Storage.Contract.Frozen_fees.remove
                              (ctxt, contract) cycle)
                            (fun ctxt =>
                              op_gtgteq
                                (Storage.Contract.Frozen_rewards.remove
                                  (ctxt, contract) cycle)
                                (fun ctxt =>
                                  __return
                                    (ctxt,
                                      {| deposit := deposit; fees := fees;
                                        rewards := rewards |}))))))))).

Definition has_frozen_balance
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (cycle : Tezos_raw_protocol_alpha.Storage.Contract.Frozen_deposits.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool) :=
  let contract := Contract_repr.implicit_contract delegate in
  op_gtgteqquestion (get_frozen_deposit ctxt contract cycle)
    (fun deposit =>
      if op_ltgt deposit zero then
        return_true
      else
        op_gtgteqquestion (get_frozen_fees ctxt contract cycle)
          (fun fees =>
            if op_ltgt fees zero then
              return_true
            else
              op_gtgteqquestion (get_frozen_rewards ctxt contract cycle)
                (fun rewards => __return (op_ltgt rewards zero)))).

Definition frozen_balance_by_cycle_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (Tezos_raw_protocol_alpha.Cycle_repr.Map.t frozen_balance) :=
  conv Cycle_repr.Map.bindings
    (List.fold_left
      (fun m =>
        fun function_parameter =>
          let '(c, b) := function_parameter in
          Cycle_repr.Map.add c b m) Cycle_repr.Map.empty) None
    (list None
      (merge_objs (obj1 (req None None "cycle" % string Cycle_repr.encoding))
        frozen_balance_encoding)).

Definition empty_frozen_balance : frozen_balance :=
  {| deposit := Tez_repr.zero; fees := Tez_repr.zero; rewards := Tez_repr.zero
    |}.

Definition frozen_balance_by_cycle
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_raw_protocol_alpha.Cycle_repr.Map.t frozen_balance) :=
  let contract := Contract_repr.implicit_contract delegate in
  let map := Cycle_repr.Map.empty in
  op_gtgteq
    (Storage.Contract.Frozen_deposits.fold (ctxt, contract) map
      (fun cycle =>
        fun amount =>
          fun map =>
            Lwt.__return
              (Cycle_repr.Map.add cycle
                (* ❌ Record substitution not handled *)
                record_substitution map)))
    (fun map =>
      op_gtgteq
        (Storage.Contract.Frozen_fees.fold (ctxt, contract) map
          (fun cycle =>
            fun amount =>
              fun map =>
                let balance :=
                  match Cycle_repr.Map.find_opt cycle map with
                  | None => empty_frozen_balance
                  | Some balance => balance
                  end in
                Lwt.__return
                  (Cycle_repr.Map.add cycle
                    (* ❌ Record substitution not handled *)
                    record_substitution map)))
        (fun map =>
          op_gtgteq
            (Storage.Contract.Frozen_rewards.fold (ctxt, contract) map
              (fun cycle =>
                fun amount =>
                  fun map =>
                    let balance :=
                      match Cycle_repr.Map.find_opt cycle map with
                      | None => empty_frozen_balance
                      | Some balance => balance
                      end in
                    Lwt.__return
                      (Cycle_repr.Map.add cycle
                        (* ❌ Record substitution not handled *)
                        record_substitution map))) (fun map => Lwt.__return map))).

Definition frozen_balance
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Pervasives.result
      Tezos_raw_protocol_alpha.Tez_repr.t
      (list Tezos_protocol_environment_alpha__Environment.Error_monad.error)) :=
  let contract := Contract_repr.implicit_contract delegate in
  let balance :=
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok Tez_repr.zero in
  op_gtgteq
    (Storage.Contract.Frozen_deposits.fold (ctxt, contract) balance
      (fun _cycle =>
        fun amount =>
          fun acc =>
            op_gtgteqquestion (Lwt.__return acc)
              (fun acc => Lwt.__return (op_plusquestion acc amount))))
    (fun balance =>
      op_gtgteq
        (Storage.Contract.Frozen_fees.fold (ctxt, contract) balance
          (fun _cycle =>
            fun amount =>
              fun acc =>
                op_gtgteqquestion (Lwt.__return acc)
                  (fun acc => Lwt.__return (op_plusquestion acc amount))))
        (fun balance =>
          op_gtgteq
            (Storage.Contract.Frozen_rewards.fold (ctxt, contract) balance
              (fun _cycle =>
                fun amount =>
                  fun acc =>
                    op_gtgteqquestion (Lwt.__return acc)
                      (fun acc => Lwt.__return (op_plusquestion acc amount))))
            (fun balance => Lwt.__return balance))).

Definition full_balance
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t) :=
  let contract := Contract_repr.implicit_contract delegate in
  op_gtgteqquestion (frozen_balance ctxt delegate)
    (fun frozen_balance =>
      op_gtgteqquestion (Storage.Contract.Balance.get ctxt contract)
        (fun balance => Lwt.__return (op_plusquestion frozen_balance balance))).

Definition deactivated
  : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool) :=
  Roll_storage.Delegate.is_inactive.

Definition grace_period
  (ctxt :
    Tezos_raw_protocol_alpha.Storage.Contract.Delegate_desactivation.context)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Contract.Delegate_desactivation.value) :=
  let contract := Contract_repr.implicit_contract delegate in
  Storage.Contract.Delegate_desactivation.get ctxt contract.

Definition staking_balance
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t) :=
  let token_per_rolls := Constants_storage.tokens_per_roll ctxt in
  op_gtgteqquestion (Roll_storage.get_rolls ctxt delegate)
    (fun rolls =>
      op_gtgteqquestion (Roll_storage.get_change ctxt delegate)
        (fun change =>
          let rolls := Int64.of_int (List.length rolls) in
          op_gtgteqquestion
            (Lwt.__return (op_starquestion token_per_rolls rolls))
            (fun balance => Lwt.__return (op_plusquestion balance change)))).

Definition delegated_balance
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t) :=
  let contract := Contract_repr.implicit_contract delegate in
  op_gtgteqquestion (staking_balance ctxt delegate)
    (fun staking_balance =>
      op_gtgteq (Storage.Contract.Balance.get ctxt contract)
        (fun self_staking_balance =>
          op_gtgteq
            (Storage.Contract.Frozen_deposits.fold (ctxt, contract)
              self_staking_balance
              (fun _cycle =>
                fun amount =>
                  fun acc =>
                    op_gtgteqquestion (Lwt.__return acc)
                      (fun acc => Lwt.__return (op_plusquestion acc amount))))
            (fun self_staking_balance =>
              op_gtgteqquestion
                (Storage.Contract.Frozen_fees.fold (ctxt, contract)
                  self_staking_balance
                  (fun _cycle =>
                    fun amount =>
                      fun acc =>
                        op_gtgteqquestion (Lwt.__return acc)
                          (fun acc => Lwt.__return (op_plusquestion acc amount))))
                (fun self_staking_balance =>
                  Lwt.__return
                    (op_minusquestion staking_balance self_staking_balance))))).

Definition fold {A : Type}
  : Tezos_raw_protocol_alpha.Storage.Delegates.context ->
    A ->
      (Tezos_raw_protocol_alpha.Storage.Delegates.elt ->
        A -> Tezos_protocol_environment_alpha__Environment.Lwt.t A) ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t A :=
  Storage.Delegates.fold.

Definition list
  : Tezos_raw_protocol_alpha.Storage.Delegates.context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (list Tezos_raw_protocol_alpha.Storage.Delegates.elt) :=
  Storage.Delegates.elements.
delegate_storage.mli 2 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Places where tezzies can be found in the ledger's state. *)
type balance =
  | Contract of Contract_repr.t
  | Rewards of Signature.Public_key_hash.t * Cycle_repr.t
  | Fees of Signature.Public_key_hash.t * Cycle_repr.t
  | Deposits of Signature.Public_key_hash.t * Cycle_repr.t

(** A credit or debit of tezzies to a balance. *)
type balance_update = Debited of Tez_repr.t | Credited of Tez_repr.t

(** A list of balance updates. Duplicates may happen. *)
type balance_updates = (balance * balance_update) list

val balance_updates_encoding : balance_updates Data_encoding.t

(** Remove zero-valued balances from a list of updates. *)
val cleanup_balance_updates : balance_updates -> balance_updates

type frozen_balance = {
  deposit : Tez_repr.t;
  fees : Tez_repr.t;
  rewards : Tez_repr.t;
}

(** Allow to register a delegate when creating an account. *)
val init :
  Raw_context.t ->
  Contract_repr.t ->
  Signature.Public_key_hash.t ->
  Raw_context.t tzresult Lwt.t

(** Cleanup delegation when deleting a contract. *)
val remove : Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t

(** Reading the current delegate of a contract. *)
val get :
  Raw_context.t ->
  Contract_repr.t ->
  Signature.Public_key_hash.t option tzresult Lwt.t

val registered :
  Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t

(** Updating the delegate of a contract.

    When calling this function on an "implicit contract" and setting
    the delegate to the contract manager registers it as a delegate. One
    cannot unregister a delegate for now. The associate contract is now
    'undeletable'. *)
val set :
  Raw_context.t ->
  Contract_repr.t ->
  Signature.Public_key_hash.t option ->
  Raw_context.t tzresult Lwt.t

type error +=
  | No_deletion of Signature.Public_key_hash.t (* `Permanent *)
  | Active_delegate (* `Temporary *)
  | Current_delegate (* `Temporary *)
  | Empty_delegate_account of Signature.Public_key_hash.t (* `Temporary *)
  | Balance_too_low_for_deposit of {
      delegate : Signature.Public_key_hash.t;
      deposit : Tez_repr.t;
      balance : Tez_repr.t;
    }

(* `Temporary *)

(** Iterate on all registered delegates. *)
val fold :
  Raw_context.t ->
  init:'a ->
  f:(Signature.Public_key_hash.t -> 'a -> 'a Lwt.t) ->
  'a Lwt.t

(** List all registered delegates. *)
val list : Raw_context.t -> Signature.Public_key_hash.t list Lwt.t

(** Various functions to 'freeze' tokens.  A frozen 'deposit' keeps its
    associated rolls. When frozen, 'fees' may trigger new rolls
    allocation. Rewards won't trigger new rolls allocation until
    unfrozen. *)
val freeze_deposit :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Tez_repr.t ->
  Raw_context.t tzresult Lwt.t

val freeze_fees :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Tez_repr.t ->
  Raw_context.t tzresult Lwt.t

val freeze_rewards :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Tez_repr.t ->
  Raw_context.t tzresult Lwt.t

(** Trigger the context maintenance at the end of cycle 'n', i.e.:
    unfreeze deposit/fees/rewards from 'n - preserved_cycle' ; punish the
    provided unrevealed seeds (tipically seed from cycle 'n - 1').
    Returns a list of account with the amount that was unfrozen for each
    and the list of deactivated delegates. *)
val cycle_end :
  Raw_context.t ->
  Cycle_repr.t ->
  Nonce_storage.unrevealed list ->
  (Raw_context.t * balance_updates * Signature.Public_key_hash.t list) tzresult
  Lwt.t

(** Burn all then frozen deposit/fees/rewards for a delegate at a given
    cycle. Returns the burned amounts. *)
val punish :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Cycle_repr.t ->
  (Raw_context.t * frozen_balance) tzresult Lwt.t

(** Has the given key some frozen tokens in its implicit contract? *)
val has_frozen_balance :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Cycle_repr.t ->
  bool tzresult Lwt.t

(** Returns the amount of frozen deposit, fees and rewards associated
    to a given delegate. *)
val frozen_balance :
  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t

val frozen_balance_encoding : frozen_balance Data_encoding.t

val frozen_balance_by_cycle_encoding :
  frozen_balance Cycle_repr.Map.t Data_encoding.t

(** Returns the amount of frozen deposit, fees and rewards associated
    to a given delegate, indexed by the cycle by which at the end the
    balance will be unfrozen. *)
val frozen_balance_by_cycle :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  frozen_balance Cycle_repr.Map.t Lwt.t

(** Returns the full 'balance' of the implicit contract associated to
    a given key, i.e. the sum of the spendable balance and of the
    frozen balance. *)
val full_balance :
  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t

val staking_balance :
  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t

(** Returns the list of contracts (implicit or originated) that delegated towards a given delegate *)
val delegated_contracts :
  Raw_context.t -> Signature.Public_key_hash.t -> Contract_repr.t list Lwt.t

val delegated_balance :
  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t

val deactivated :
  Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t

val grace_period :
  Raw_context.t -> Signature.Public_key_hash.t -> Cycle_repr.t tzresult Lwt.t
delegate_storage_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive balance : Type :=
| Contract : Tezos_raw_protocol_alpha.Contract_repr.t -> balance
| Rewards :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t -> balance
| Fees :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t -> balance
| Deposits :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t -> balance.

Inductive balance_update : Type :=
| Debited : Tezos_raw_protocol_alpha.Tez_repr.t -> balance_update
| Credited : Tezos_raw_protocol_alpha.Tez_repr.t -> balance_update.

Definition balance_updates := list (balance * balance_update).

Parameter balance_updates_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t balance_updates.

Parameter cleanup_balance_updates : balance_updates -> balance_updates.

Record frozen_balance := {
  deposit : Tezos_raw_protocol_alpha.Tez_repr.t;
  fees : Tezos_raw_protocol_alpha.Tez_repr.t;
  rewards : Tezos_raw_protocol_alpha.Tez_repr.t }.

Parameter init :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).

Parameter remove :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).

Parameter get :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (option
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)).

Parameter registered :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).

Parameter set :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
    option
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
      ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).

extensible_type

Parameter fold : forall {a : Type},
Tezos_raw_protocol_alpha.Raw_context.t ->
  a ->
    (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
      -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a.

Parameter list :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (list
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t).

Parameter freeze_deposit :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_raw_protocol_alpha.Tez_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).

Parameter freeze_fees :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_raw_protocol_alpha.Tez_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).

Parameter freeze_rewards :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_raw_protocol_alpha.Tez_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).

Parameter cycle_end :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t ->
    list Tezos_raw_protocol_alpha.Nonce_storage.unrevealed ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * balance_updates *
            list
              Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)).

Parameter punish :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_raw_protocol_alpha.Cycle_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * frozen_balance)).

Parameter has_frozen_balance :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_raw_protocol_alpha.Cycle_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).

Parameter frozen_balance :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Tez_repr.t).

Parameter frozen_balance_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t frozen_balance.

Parameter frozen_balance_by_cycle_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
  (Tezos_raw_protocol_alpha.Cycle_repr.Map.t frozen_balance).

Parameter frozen_balance_by_cycle :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_raw_protocol_alpha.Cycle_repr.Map.t frozen_balance).

Parameter full_balance :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Tez_repr.t).

Parameter staking_balance :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Tez_repr.t).

Parameter delegated_contracts :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (list Tezos_raw_protocol_alpha.Contract_repr.t).

Parameter delegated_balance :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Tez_repr.t).

Parameter deactivated :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).

Parameter grace_period :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Cycle_repr.t).
fees_storage.ml 14 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type error += Cannot_pay_storage_fee (* `Temporary *)

type error += Operation_quota_exceeded (* `Temporary *)

type error += Storage_limit_too_high (* `Permanent *)

let () =
  let open Data_encoding in
  register_error_kind
    `Temporary
    ~id:"contract.cannot_pay_storage_fee"
    ~title:"Cannot pay storage fee"
    ~description:"The storage fee is higher than the contract balance"
    ~pp:(fun ppf () -> Format.fprintf ppf "Cannot pay storage storage fee")
    Data_encoding.empty
    (function Cannot_pay_storage_fee -> Some () | _ -> None)
    (fun () -> Cannot_pay_storage_fee) ;
  register_error_kind
    `Temporary
    ~id:"storage_exhausted.operation"
    ~title:"Storage quota exceeded for the operation"
    ~description:
      "A script or one of its callee wrote more bytes than the operation said \
       it would"
    Data_encoding.empty
    (function Operation_quota_exceeded -> Some () | _ -> None)
    (fun () -> Operation_quota_exceeded) ;
  register_error_kind
    `Permanent
    ~id:"storage_limit_too_high"
    ~title:"Storage limit out of protocol hard bounds"
    ~description:"A transaction tried to exceed the hard limit on storage"
    empty
    (function Storage_limit_too_high -> Some () | _ -> None)
    (fun () -> Storage_limit_too_high)

let origination_burn c =
  let origination_size = Constants_storage.origination_size c in
  let cost_per_byte = Constants_storage.cost_per_byte c in
  (* the origination burn, measured in bytes *)
  Lwt.return Tez_repr.(cost_per_byte *? Int64.of_int origination_size)
  >>=? fun to_be_paid ->
  return (Raw_context.update_allocated_contracts_count c, to_be_paid)

let record_paid_storage_space c contract =
  Contract_storage.used_storage_space c contract
  >>=? fun size ->
  Contract_storage.set_paid_storage_space_and_return_fees_to_pay
    c
    contract
    size
  >>=? fun (to_be_paid, c) ->
  let c = Raw_context.update_storage_space_to_pay c to_be_paid in
  let cost_per_byte = Constants_storage.cost_per_byte c in
  Lwt.return Tez_repr.(cost_per_byte *? Z.to_int64 to_be_paid)
  >>=? fun to_burn -> return (c, size, to_be_paid, to_burn)

let burn_storage_fees c ~storage_limit ~payer =
  let origination_size = Constants_storage.origination_size c in
  let (c, storage_space_to_pay, allocated_contracts) =
    Raw_context.clear_storage_space_to_pay c
  in
  let storage_space_for_allocated_contracts =
    Z.mul (Z.of_int allocated_contracts) (Z.of_int origination_size)
  in
  let consumed =
    Z.add storage_space_to_pay storage_space_for_allocated_contracts
  in
  let remaining = Z.sub storage_limit consumed in
  if Compare.Z.(remaining < Z.zero) then fail Operation_quota_exceeded
  else
    let cost_per_byte = Constants_storage.cost_per_byte c in
    Lwt.return Tez_repr.(cost_per_byte *? Z.to_int64 consumed)
    >>=? fun to_burn ->
    (* Burning the fees... *)
    if Tez_repr.(to_burn = Tez_repr.zero) then
      (* If the payer was was deleted by transfering all its balance, and no space was used,
         burning zero would fail *)
      return c
    else
      trace
        Cannot_pay_storage_fee
        ( Contract_storage.must_exist c payer
        >>=? fun () -> Contract_storage.spend c payer to_burn )
      >>=? fun c -> return c

let check_storage_limit c ~storage_limit =
  if
    Compare.Z.(
      storage_limit
      > (Raw_context.constants c).hard_storage_limit_per_operation)
    || Compare.Z.(storage_limit < Z.zero)
  then error Storage_limit_too_high
  else ok ()

let start_counting_storage_fees c = Raw_context.init_storage_space_to_pay c
fees_storage_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.cannot_pay_storage_fee" % string
      "Cannot pay storage fee" % string
      "The storage fee is higher than the contract balance" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Cannot pay storage storage fee" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Cannot pay storage storage fee" % string))) Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_pay_storage_fee
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_pay_storage_fee)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "storage_exhausted.operation" % string
      "Storage quota exceeded for the operation" % string
      "A script or one of its callee wrote more bytes than the operation said it would"
        % string None Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Operation_quota_exceeded
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Operation_quota_exceeded)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "storage_limit_too_high" % string
    "Storage limit out of protocol hard bounds" % string
    "A transaction tried to exceed the hard limit on storage" % string None
    empty
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Storage_limit_too_high
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Storage_limit_too_high).

Definition origination_burn (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        Tezos_raw_protocol_alpha.Tez_repr.t)) :=
  let origination_size := Constants_storage.origination_size c in
  let cost_per_byte := Constants_storage.cost_per_byte c in
  op_gtgteqquestion
    (Lwt.__return
      (op_starquestion cost_per_byte (Int64.of_int origination_size)))
    (fun to_be_paid =>
      __return ((Raw_context.update_allocated_contracts_count c), to_be_paid)).

Definition record_paid_storage_space
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  (contract : Tezos_raw_protocol_alpha.Contract_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        Tezos_protocol_environment_alpha__Environment.Z.t *
        Tezos_protocol_environment_alpha__Environment.Z.t *
        Tezos_raw_protocol_alpha.Tez_repr.t)) :=
  op_gtgteqquestion (Contract_storage.used_storage_space c contract)
    (fun size =>
      op_gtgteqquestion
        (Contract_storage.set_paid_storage_space_and_return_fees_to_pay c
          contract size)
        (fun function_parameter =>
          let '(to_be_paid, c) := function_parameter in
          let c := Raw_context.update_storage_space_to_pay c to_be_paid in
          let cost_per_byte := Constants_storage.cost_per_byte c in
          op_gtgteqquestion
            (Lwt.__return
              (op_starquestion cost_per_byte (Z.to_int64 to_be_paid)))
            (fun to_burn => __return (c, size, to_be_paid, to_burn)))).

Definition burn_storage_fees
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  (storage_limit : Tezos_protocol_environment_alpha__Environment.Z.t)
  (payer : Tezos_raw_protocol_alpha.Contract_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let origination_size := Constants_storage.origination_size c in
  let '(c, storage_space_to_pay, allocated_contracts) :=
    Raw_context.clear_storage_space_to_pay c in
  let storage_space_for_allocated_contracts :=
    Z.mul (Z.of_int allocated_contracts) (Z.of_int origination_size) in
  let consumed :=
    Z.add storage_space_to_pay storage_space_for_allocated_contracts in
  let remaining := Z.sub storage_limit consumed in
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
      remaining Z.zero then
    fail
      Tezos_protocol_environment_alpha__Environment.Error_monad.Operation_quota_exceeded
  else
    let cost_per_byte := Constants_storage.cost_per_byte c in
    op_gtgteqquestion
      (Lwt.__return (op_starquestion cost_per_byte (Z.to_int64 consumed)))
      (fun to_burn =>
        if op_eq to_burn Tez_repr.zero then
          __return c
        else
          op_gtgteqquestion
            (trace
              Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_pay_storage_fee
              (op_gtgteqquestion (Contract_storage.must_exist c payer)
                (fun function_parameter =>
                  let 'tt := function_parameter in
                  Contract_storage.spend c payer to_burn)))
            (fun c => __return c)).

Definition check_storage_limit
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  (storage_limit :
    Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
  if
    op_pipepipe
      (Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
        storage_limit
        (hard_storage_limit_per_operation (Raw_context.constants c)))
      (Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
        storage_limit Z.zero) then
    error
      Tezos_protocol_environment_alpha__Environment.Error_monad.Storage_limit_too_high
  else
    ok tt.

Definition start_counting_storage_fees
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  : Tezos_raw_protocol_alpha.Raw_context.t :=
  Raw_context.init_storage_space_to_pay c.
fees_storage.mli 4 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type error += Cannot_pay_storage_fee (* `Temporary *)

type error += Operation_quota_exceeded (* `Temporary *)

type error += Storage_limit_too_high (* `Permanent *)

(** Does not burn, only adds the burn to storage space to be paid *)
val origination_burn :
  Raw_context.t -> (Raw_context.t * Tez_repr.t) tzresult Lwt.t

(** The returned Tez quantity is for logging purpose only *)
val record_paid_storage_space :
  Raw_context.t ->
  Contract_repr.t ->
  (Raw_context.t * Z.t * Z.t * Tez_repr.t) tzresult Lwt.t

val check_storage_limit : Raw_context.t -> storage_limit:Z.t -> unit tzresult

val start_counting_storage_fees : Raw_context.t -> Raw_context.t

val burn_storage_fees :
  Raw_context.t ->
  storage_limit:Z.t ->
  payer:Contract_repr.t ->
  Raw_context.t tzresult Lwt.t
fees_storage_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

extensible_type

extensible_type

extensible_type

Parameter origination_burn :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        Tezos_raw_protocol_alpha.Tez_repr.t)).

Parameter record_paid_storage_space :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Raw_context.t *
          Tezos_protocol_environment_alpha__Environment.Z.t *
          Tezos_protocol_environment_alpha__Environment.Z.t *
          Tezos_raw_protocol_alpha.Tez_repr.t)).

Parameter check_storage_limit :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.

Parameter start_counting_storage_fees :
Tezos_raw_protocol_alpha.Raw_context.t -> Tezos_raw_protocol_alpha.Raw_context.t.

Parameter burn_storage_fees :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_raw_protocol_alpha.Contract_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
fitness_repr.ml 6 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type error += Invalid_fitness (* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"invalid_fitness"
    ~title:"Invalid fitness"
    ~description:"Fitness representation should be exactly 8 bytes long."
    ~pp:(fun ppf () -> Format.fprintf ppf "Invalid fitness")
    Data_encoding.empty
    (function Invalid_fitness -> Some () | _ -> None)
    (fun () -> Invalid_fitness)

let int64_to_bytes i =
  let b = MBytes.create 8 in
  MBytes.set_int64 b 0 i ; b

let int64_of_bytes b =
  if Compare.Int.(MBytes.length b <> 8) then error Invalid_fitness
  else ok (MBytes.get_int64 b 0)

let from_int64 fitness =
  [MBytes.of_string Constants_repr.version_number; int64_to_bytes fitness]

let to_int64 = function
  | [version; fitness]
    when Compare.String.(
           MBytes.to_string version = Constants_repr.version_number) ->
      int64_of_bytes fitness
  | [version; _fitness (* ignored since higher version takes priority *)]
    when Compare.String.(
           MBytes.to_string version = Constants_repr.version_number_004) ->
      ok 0L
  | [] ->
      ok 0L
  | _ ->
      error Invalid_fitness
fitness_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "invalid_fitness" % string "Invalid fitness" % string
    "Fitness representation should be exactly 8 bytes long." % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "Invalid fitness" % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "Invalid fitness" % string))) Data_encoding.empty
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_fitness
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_fitness).

Definition int64_to_bytes (i : int64)
  : Tezos_protocol_environment_alpha__Environment.MBytes.t :=
  let b := MBytes.create 8 in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := MBytes.set_int64 b 0 i in
  b.

Definition int64_of_bytes
  (b : Tezos_protocol_environment_alpha__Environment.MBytes.t)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int64 :=
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_ltgt)
      (MBytes.length b) 8 then
    error
      Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_fitness
  else
    ok (MBytes.get_int64 b 0).

Definition from_int64 (fitness : int64)
  : list Tezos_protocol_environment_alpha__Environment.MBytes.t :=
  cons (MBytes.of_string Constants_repr.version_number)
    (cons (int64_to_bytes fitness) []).

Definition to_int64
  (function_parameter :
    list Tezos_protocol_environment_alpha__Environment.MBytes.t)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int64 :=
  match function_parameter with
  | cons version (cons fitness []) => int64_of_bytes fitness
  | cons version (cons _fitness []) =>
    ok
      (* ❌ Constant of type int64 is converted to int *)
      0
  | [] =>
    ok
      (* ❌ Constant of type int64 is converted to int *)
      0
  | _ =>
    error
      Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_fitness
  end.
fitness_storage.ml 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

let current = Raw_context.current_fitness

let increase ?(gap = 1) ctxt =
  let fitness = current ctxt in
  Raw_context.set_current_fitness ctxt (Int64.add (Int64.of_int gap) fitness)
fitness_storage_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition current
  : Tezos_raw_protocol_alpha.Raw_context.context ->
    Tezos_protocol_environment_alpha__Environment.Int64.t :=
  Raw_context.current_fitness.

Definition increase (op_staroptstar : option Z)
  : Tezos_raw_protocol_alpha.Raw_context.context ->
    Tezos_raw_protocol_alpha.Raw_context.t :=
  let gap :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => 1
    end in
  fun ctxt =>
    let fitness := current ctxt in
    Raw_context.set_current_fitness ctxt (Int64.add (Int64.of_int gap) fitness).
gas_limit_repr.ml 11 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = Unaccounted | Limited of {remaining : Z.t}

type internal_gas = Z.t

type cost = {
  allocations : Z.t;
  steps : Z.t;
  reads : Z.t;
  writes : Z.t;
  bytes_read : Z.t;
  bytes_written : Z.t;
}

let encoding =
  let open Data_encoding in
  union
    [ case
        (Tag 0)
        ~title:"Limited"
        z
        (function Limited {remaining} -> Some remaining | _ -> None)
        (fun remaining -> Limited {remaining});
      case
        (Tag 1)
        ~title:"Unaccounted"
        (constant "unaccounted")
        (function Unaccounted -> Some () | _ -> None)
        (fun () -> Unaccounted) ]

let pp ppf = function
  | Unaccounted ->
      Format.fprintf ppf "unaccounted"
  | Limited {remaining} ->
      Format.fprintf ppf "%s units remaining" (Z.to_string remaining)

let cost_encoding =
  let open Data_encoding in
  conv
    (fun {allocations; steps; reads; writes; bytes_read; bytes_written} ->
      (allocations, steps, reads, writes, bytes_read, bytes_written))
    (fun (allocations, steps, reads, writes, bytes_read, bytes_written) ->
      {allocations; steps; reads; writes; bytes_read; bytes_written})
    (obj6
       (req "allocations" z)
       (req "steps" z)
       (req "reads" z)
       (req "writes" z)
       (req "bytes_read" z)
       (req "bytes_written" z))

let pp_cost ppf {allocations; steps; reads; writes; bytes_read; bytes_written}
    =
  Format.fprintf
    ppf
    "(steps: %s, allocs: %s, reads: %s (%s bytes), writes: %s (%s bytes))"
    (Z.to_string steps)
    (Z.to_string allocations)
    (Z.to_string reads)
    (Z.to_string bytes_read)
    (Z.to_string writes)
    (Z.to_string bytes_written)

type error += Block_quota_exceeded (* `Temporary *)

type error += Operation_quota_exceeded (* `Temporary *)

let allocation_weight = Z.of_int 2

let step_weight = Z.of_int 1

let read_base_weight = Z.of_int 100

let write_base_weight = Z.of_int 160

let byte_read_weight = Z.of_int 10

let byte_written_weight = Z.of_int 15

let rescaling_bits = 7

let rescaling_mask = Z.sub (Z.shift_left Z.one rescaling_bits) Z.one

let scale (z : Z.t) = Z.shift_left z rescaling_bits

let rescale (z : Z.t) = Z.shift_right z rescaling_bits

let cost_to_internal_gas (cost : cost) : internal_gas =
  Z.add
    (Z.add
       (Z.mul cost.allocations allocation_weight)
       (Z.mul cost.steps step_weight))
    (Z.add
       (Z.add
          (Z.mul cost.reads read_base_weight)
          (Z.mul cost.writes write_base_weight))
       (Z.add
          (Z.mul cost.bytes_read byte_read_weight)
          (Z.mul cost.bytes_written byte_written_weight)))

let internal_gas_to_gas internal_gas : Z.t * internal_gas =
  let gas = rescale internal_gas in
  let rest = Z.logand internal_gas rescaling_mask in
  (gas, rest)

let consume block_gas operation_gas internal_gas cost =
  match operation_gas with
  | Unaccounted ->
      ok (block_gas, Unaccounted, internal_gas)
  | Limited {remaining} ->
      let cost_internal_gas = cost_to_internal_gas cost in
      let total_internal_gas = Z.add cost_internal_gas internal_gas in
      let (gas, rest) = internal_gas_to_gas total_internal_gas in
      if Compare.Z.(gas > Z.zero) then
        let remaining = Z.sub remaining gas in
        let block_remaining = Z.sub block_gas gas in
        if Compare.Z.(remaining < Z.zero) then error Operation_quota_exceeded
        else if Compare.Z.(block_remaining < Z.zero) then
          error Block_quota_exceeded
        else ok (block_remaining, Limited {remaining}, rest)
      else ok (block_gas, operation_gas, total_internal_gas)

let check_enough block_gas operation_gas internal_gas cost =
  consume block_gas operation_gas internal_gas cost
  >|? fun (_block_remainig, _remaining, _internal_gas) -> ()

let internal_gas_zero : internal_gas = Z.zero

let alloc_cost n =
  {
    allocations = scale (Z.of_int (n + 1));
    steps = Z.zero;
    reads = Z.zero;
    writes = Z.zero;
    bytes_read = Z.zero;
    bytes_written = Z.zero;
  }

let alloc_bytes_cost n = alloc_cost ((n + 7) / 8)

let alloc_bits_cost n = alloc_cost ((n + 63) / 64)

let atomic_step_cost n =
  {
    allocations = Z.zero;
    steps = Z.of_int (2 * n);
    reads = Z.zero;
    writes = Z.zero;
    bytes_read = Z.zero;
    bytes_written = Z.zero;
  }

let step_cost n =
  {
    allocations = Z.zero;
    steps = scale (Z.of_int n);
    reads = Z.zero;
    writes = Z.zero;
    bytes_read = Z.zero;
    bytes_written = Z.zero;
  }

let free =
  {
    allocations = Z.zero;
    steps = Z.zero;
    reads = Z.zero;
    writes = Z.zero;
    bytes_read = Z.zero;
    bytes_written = Z.zero;
  }

let read_bytes_cost n =
  {
    allocations = Z.zero;
    steps = Z.zero;
    reads = scale Z.one;
    writes = Z.zero;
    bytes_read = scale n;
    bytes_written = Z.zero;
  }

let write_bytes_cost n =
  {
    allocations = Z.zero;
    steps = Z.zero;
    reads = Z.zero;
    writes = Z.one;
    bytes_read = Z.zero;
    bytes_written = scale n;
  }

let ( +@ ) x y =
  {
    allocations = Z.add x.allocations y.allocations;
    steps = Z.add x.steps y.steps;
    reads = Z.add x.reads y.reads;
    writes = Z.add x.writes y.writes;
    bytes_read = Z.add x.bytes_read y.bytes_read;
    bytes_written = Z.add x.bytes_written y.bytes_written;
  }

let ( *@ ) x y =
  {
    allocations = Z.mul (Z.of_int x) y.allocations;
    steps = Z.mul (Z.of_int x) y.steps;
    reads = Z.mul (Z.of_int x) y.reads;
    writes = Z.mul (Z.of_int x) y.writes;
    bytes_read = Z.mul (Z.of_int x) y.bytes_read;
    bytes_written = Z.mul (Z.of_int x) y.bytes_written;
  }

let alloc_mbytes_cost n = alloc_cost 12 +@ alloc_bytes_cost n

let () =
  let open Data_encoding in
  register_error_kind
    `Temporary
    ~id:"gas_exhausted.operation"
    ~title:"Gas quota exceeded for the operation"
    ~description:
      "A script or one of its callee took more time than the operation said \
       it would"
    empty
    (function Operation_quota_exceeded -> Some () | _ -> None)
    (fun () -> Operation_quota_exceeded) ;
  register_error_kind
    `Temporary
    ~id:"gas_exhausted.block"
    ~title:"Gas quota exceeded for the block"
    ~description:
      "The sum of gas consumed by all the operations in the block exceeds the \
       hard gas limit per block"
    empty
    (function Block_quota_exceeded -> Some () | _ -> None)
    (fun () -> Block_quota_exceeded)
gas_limit_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive t : Type :=
| Unaccounted : t
| Limited : Tezos_protocol_environment_alpha__Environment.Z.t -> t.

Definition internal_gas := Tezos_protocol_environment_alpha__Environment.Z.t.

Record cost := {
  allocations : Tezos_protocol_environment_alpha__Environment.Z.t;
  steps : Tezos_protocol_environment_alpha__Environment.Z.t;
  reads : Tezos_protocol_environment_alpha__Environment.Z.t;
  writes : Tezos_protocol_environment_alpha__Environment.Z.t;
  bytes_read : Tezos_protocol_environment_alpha__Environment.Z.t;
  bytes_written : Tezos_protocol_environment_alpha__Environment.Z.t }.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
  union None
    (cons
      (case "Limited" % string None
        (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0) z
        (fun function_parameter =>
          match function_parameter with
          | Limited {| remaining := remaining |} => Some remaining
          | _ => None
          end) (fun remaining => Limited {| remaining := remaining |}))
      (cons
        (case "Unaccounted" % string None
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
          (constant "unaccounted" % string)
          (fun function_parameter =>
            match function_parameter with
            | Unaccounted => Some tt
            | _ => None
            end)
          (fun function_parameter =>
            let 'tt := function_parameter in
            Unaccounted)) [])).

Definition pp
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (function_parameter : t) : unit :=
  match function_parameter with
  | Unaccounted =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
          "unaccounted" % string
          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
        "unaccounted" % string)
  | Limited {| remaining := remaining |} =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
            " units remaining" % string
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))
        "%s units remaining" % string) (Z.to_string remaining)
  end.

Definition cost_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding cost :=
  conv
    (fun function_parameter =>
      let '{|
        allocations := allocations;
          steps := steps;
          reads := reads;
          writes := writes;
          bytes_read := bytes_read;
          bytes_written := bytes_written
          |} := function_parameter in
      (allocations, steps, reads, writes, bytes_read, bytes_written))
    (fun function_parameter =>
      let '(allocations, steps, reads, writes, bytes_read, bytes_written) :=
        function_parameter in
      {| allocations := allocations; steps := steps; reads := reads;
        writes := writes; bytes_read := bytes_read;
        bytes_written := bytes_written |}) None
    (obj6 (req None None "allocations" % string z)
      (req None None "steps" % string z) (req None None "reads" % string z)
      (req None None "writes" % string z)
      (req None None "bytes_read" % string z)
      (req None None "bytes_written" % string z)).

Definition pp_cost
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (function_parameter : cost) : unit :=
  let '{|
    allocations := allocations;
      steps := steps;
      reads := reads;
      writes := writes;
      bytes_read := bytes_read;
      bytes_written := bytes_written
      |} := function_parameter in
  Format.fprintf ppf
    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
        "(steps: " % string
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
            ", allocs: " % string
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                ", reads: " % string
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    " (" % string
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                        " bytes), writes: " % string
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                            " (" % string
                            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                                " bytes))" % string
                                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))))))))))
      "(steps: %s, allocs: %s, reads: %s (%s bytes), writes: %s (%s bytes))" %
        string) (Z.to_string steps) (Z.to_string allocations)
    (Z.to_string reads) (Z.to_string bytes_read) (Z.to_string writes)
    (Z.to_string bytes_written).

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

Definition allocation_weight
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.of_int 2.

Definition step_weight : Tezos_protocol_environment_alpha__Environment.Z.t :=
  Z.of_int 1.

Definition read_base_weight
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.of_int 100.

Definition write_base_weight
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.of_int 160.

Definition byte_read_weight
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.of_int 10.

Definition byte_written_weight
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.of_int 15.

Definition rescaling_bits : Z := 7.

Definition rescaling_mask : Tezos_protocol_environment_alpha__Environment.Z.t :=
  Z.sub (Z.shift_left Z.one rescaling_bits) Z.one.

Definition scale (z : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t :=
  Z.shift_left z rescaling_bits.

Definition rescale (z : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t :=
  Z.shift_right z rescaling_bits.

Definition cost_to_internal_gas (cost : cost) : internal_gas :=
  Z.add
    (Z.add (Z.mul (allocations cost) allocation_weight)
      (Z.mul (steps cost) step_weight))
    (Z.add
      (Z.add (Z.mul (reads cost) read_base_weight)
        (Z.mul (writes cost) write_base_weight))
      (Z.add (Z.mul (bytes_read cost) byte_read_weight)
        (Z.mul (bytes_written cost) byte_written_weight))).

Definition internal_gas_to_gas
  (internal_gas : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t * internal_gas :=
  let gas := rescale internal_gas in
  let rest := Z.logand internal_gas rescaling_mask in
  (gas, rest).

Definition consume
  (block_gas : Tezos_protocol_environment_alpha__Environment.Z.t)
  (operation_gas : t)
  (internal_gas : Tezos_protocol_environment_alpha__Environment.Z.t)
  (cost : cost)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_protocol_environment_alpha__Environment.Z.t * t *
      Tezos_protocol_environment_alpha__Environment.Z.t) :=
  match operation_gas with
  | Unaccounted => ok (block_gas, Unaccounted, internal_gas)
  | Limited {| remaining := remaining |} =>
    let cost_internal_gas := cost_to_internal_gas cost in
    let total_internal_gas := Z.add cost_internal_gas internal_gas in
    let '(gas, rest) := internal_gas_to_gas total_internal_gas in
    if
      Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
        gas Z.zero then
      let remaining := Z.sub remaining gas in
      let block_remaining := Z.sub block_gas gas in
      if
        Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
          remaining Z.zero then
        error
          Tezos_protocol_environment_alpha__Environment.Error_monad.Operation_quota_exceeded
      else
        if
          Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
            block_remaining Z.zero then
          error
            Tezos_protocol_environment_alpha__Environment.Error_monad.Block_quota_exceeded
        else
          ok (block_remaining, (Limited {| remaining := remaining |}), rest)
    else
      ok (block_gas, operation_gas, total_internal_gas)
  end.

Definition check_enough
  (block_gas : Tezos_protocol_environment_alpha__Environment.Z.t)
  (operation_gas : t)
  (internal_gas : Tezos_protocol_environment_alpha__Environment.Z.t)
  (cost : cost)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
  op_gtpipequestion (consume block_gas operation_gas internal_gas cost)
    (fun function_parameter =>
      let '(_block_remainig, _remaining, _internal_gas) := function_parameter in
      tt).

Definition internal_gas_zero : internal_gas := Z.zero.

Definition alloc_cost (n : Z) : cost :=
  {| allocations := scale (Z.of_int (op_plus n 1)); steps := Z.zero;
    reads := Z.zero; writes := Z.zero; bytes_read := Z.zero;
    bytes_written := Z.zero |}.

Definition alloc_bytes_cost (n : Z) : cost :=
  alloc_cost (op_div (op_plus n 7) 8).

Definition alloc_bits_cost (n : Z) : cost :=
  alloc_cost (op_div (op_plus n 63) 64).

Definition atomic_step_cost (n : Z) : cost :=
  {| allocations := Z.zero; steps := Z.of_int (op_star 2 n); reads := Z.zero;
    writes := Z.zero; bytes_read := Z.zero; bytes_written := Z.zero |}.

Definition step_cost (n : Z) : cost :=
  {| allocations := Z.zero; steps := scale (Z.of_int n); reads := Z.zero;
    writes := Z.zero; bytes_read := Z.zero; bytes_written := Z.zero |}.

Definition free : cost :=
  {| allocations := Z.zero; steps := Z.zero; reads := Z.zero; writes := Z.zero;
    bytes_read := Z.zero; bytes_written := Z.zero |}.

Definition read_bytes_cost
  (n : Tezos_protocol_environment_alpha__Environment.Z.t) : cost :=
  {| allocations := Z.zero; steps := Z.zero; reads := scale Z.one;
    writes := Z.zero; bytes_read := scale n; bytes_written := Z.zero |}.

Definition write_bytes_cost
  (n : Tezos_protocol_environment_alpha__Environment.Z.t) : cost :=
  {| allocations := Z.zero; steps := Z.zero; reads := Z.zero; writes := Z.one;
    bytes_read := Z.zero; bytes_written := scale n |}.

Definition op_plusat (x : cost) (y : cost) : cost :=
  {| allocations := Z.add (allocations x) (allocations y);
    steps := Z.add (steps x) (steps y); reads := Z.add (reads x) (reads y);
    writes := Z.add (writes x) (writes y);
    bytes_read := Z.add (bytes_read x) (bytes_read y);
    bytes_written := Z.add (bytes_written x) (bytes_written y) |}.

Definition op_starat (x : Z) (y : cost) : cost :=
  {| allocations := Z.mul (Z.of_int x) (allocations y);
    steps := Z.mul (Z.of_int x) (steps y);
    reads := Z.mul (Z.of_int x) (reads y);
    writes := Z.mul (Z.of_int x) (writes y);
    bytes_read := Z.mul (Z.of_int x) (bytes_read y);
    bytes_written := Z.mul (Z.of_int x) (bytes_written y) |}.

Definition alloc_mbytes_cost (n : Z) : cost :=
  op_plusat (alloc_cost 12) (alloc_bytes_cost n).

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "gas_exhausted.operation" % string
      "Gas quota exceeded for the operation" % string
      "A script or one of its callee took more time than the operation said it would"
        % string None empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Operation_quota_exceeded
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Operation_quota_exceeded)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "gas_exhausted.block" % string
    "Gas quota exceeded for the block" % string
    "The sum of gas consumed by all the operations in the block exceeds the hard gas limit per block"
      % string None empty
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Block_quota_exceeded
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Block_quota_exceeded).
gas_limit_repr.mli 4 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = Unaccounted | Limited of {remaining : Z.t}

type internal_gas

val encoding : t Data_encoding.encoding

val pp : Format.formatter -> t -> unit

type cost

val cost_encoding : cost Data_encoding.encoding

val pp_cost : Format.formatter -> cost -> unit

type error += Block_quota_exceeded (* `Temporary *)

type error += Operation_quota_exceeded (* `Temporary *)

val consume :
  Z.t -> t -> internal_gas -> cost -> (Z.t * t * internal_gas) tzresult

val check_enough : Z.t -> t -> internal_gas -> cost -> unit tzresult

val internal_gas_zero : internal_gas

val free : cost

val atomic_step_cost : int -> cost

val step_cost : int -> cost

val alloc_cost : int -> cost

val alloc_bytes_cost : int -> cost

val alloc_mbytes_cost : int -> cost

val alloc_bits_cost : int -> cost

val read_bytes_cost : Z.t -> cost

val write_bytes_cost : Z.t -> cost

val ( *@ ) : int -> cost -> cost

val ( +@ ) : cost -> cost -> cost
gas_limit_repr_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive t : Type :=
| Unaccounted : t
| Limited : Tezos_protocol_environment_alpha__Environment.Z.t -> t.

Parameter internal_gas : Type.

Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t.

Parameter pp :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.

Parameter cost : Type.

Parameter cost_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding cost.

Parameter pp_cost :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> cost -> unit.

extensible_type

extensible_type

Parameter consume :
Tezos_protocol_environment_alpha__Environment.Z.t ->
  t ->
    internal_gas ->
      cost ->
        Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_protocol_environment_alpha__Environment.Z.t * t * internal_gas).

Parameter check_enough :
Tezos_protocol_environment_alpha__Environment.Z.t ->
  t ->
    internal_gas ->
      cost ->
        Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.

Parameter internal_gas_zero : internal_gas.

Parameter free : cost.

Parameter atomic_step_cost : Z -> cost.

Parameter step_cost : Z -> cost.

Parameter alloc_cost : Z -> cost.

Parameter alloc_bytes_cost : Z -> cost.

Parameter alloc_mbytes_cost : Z -> cost.

Parameter alloc_bits_cost : Z -> cost.

Parameter read_bytes_cost :
Tezos_protocol_environment_alpha__Environment.Z.t -> cost.

Parameter write_bytes_cost :
Tezos_protocol_environment_alpha__Environment.Z.t -> cost.

Parameter op_starat : Z -> cost -> cost.

Parameter op_plusat : cost -> cost -> cost.
helpers_services.ml 383 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

type error += Cannot_parse_operation (* `Branch *)

let () =
  register_error_kind
    `Branch
    ~id:"operation.cannot_parse"
    ~title:"Cannot parse operation"
    ~description:"The operation is ill-formed or for another protocol version"
    ~pp:(fun ppf () -> Format.fprintf ppf "The operation cannot be parsed")
    Data_encoding.unit
    (function Cannot_parse_operation -> Some () | _ -> None)
    (fun () -> Cannot_parse_operation)

let parse_operation (op : Operation.raw) =
  match
    Data_encoding.Binary.of_bytes Operation.protocol_data_encoding op.proto
  with
  | Some protocol_data ->
      ok {shell = op.shell; protocol_data}
  | None ->
      error Cannot_parse_operation

let path = RPC_path.(open_root / "helpers")

module Scripts = struct
  module S = struct
    open Data_encoding

    let path = RPC_path.(path / "scripts")

    let run_code_input_encoding =
      obj9
        (req "script" Script.expr_encoding)
        (req "storage" Script.expr_encoding)
        (req "input" Script.expr_encoding)
        (req "amount" Tez.encoding)
        (req "chain_id" Chain_id.encoding)
        (opt "source" Contract.encoding)
        (opt "payer" Contract.encoding)
        (opt "gas" z)
        (dft "entrypoint" string "default")

    let trace_encoding =
      def "scripted.trace" @@ list
      @@ obj3
           (req "location" Script.location_encoding)
           (req "gas" Gas.encoding)
           (req
              "stack"
              (list
                 (obj2 (req "item" Script.expr_encoding) (opt "annot" string))))

    let run_code =
      RPC_service.post_service
        ~description:"Run a piece of code in the current context"
        ~query:RPC_query.empty
        ~input:run_code_input_encoding
        ~output:
          (obj3
             (req "storage" Script.expr_encoding)
             (req "operations" (list Operation.internal_operation_encoding))
             (opt "big_map_diff" Contract.big_map_diff_encoding))
        RPC_path.(path / "run_code")

    let trace_code =
      RPC_service.post_service
        ~description:
          "Run a piece of code in the current context, keeping a trace"
        ~query:RPC_query.empty
        ~input:run_code_input_encoding
        ~output:
          (obj4
             (req "storage" Script.expr_encoding)
             (req "operations" (list Operation.internal_operation_encoding))
             (req "trace" trace_encoding)
             (opt "big_map_diff" Contract.big_map_diff_encoding))
        RPC_path.(path / "trace_code")

    let typecheck_code =
      RPC_service.post_service
        ~description:"Typecheck a piece of code in the current context"
        ~query:RPC_query.empty
        ~input:(obj2 (req "program" Script.expr_encoding) (opt "gas" z))
        ~output:
          (obj2
             (req "type_map" Script_tc_errors_registration.type_map_enc)
             (req "gas" Gas.encoding))
        RPC_path.(path / "typecheck_code")

    let typecheck_data =
      RPC_service.post_service
        ~description:
          "Check that some data expression is well formed and of a given type \
           in the current context"
        ~query:RPC_query.empty
        ~input:
          (obj3
             (req "data" Script.expr_encoding)
             (req "type" Script.expr_encoding)
             (opt "gas" z))
        ~output:(obj1 (req "gas" Gas.encoding))
        RPC_path.(path / "typecheck_data")

    let pack_data =
      RPC_service.post_service
        ~description:
          "Computes the serialized version of some data expression using the \
           same algorithm as script instruction PACK"
        ~input:
          (obj3
             (req "data" Script.expr_encoding)
             (req "type" Script.expr_encoding)
             (opt "gas" z))
        ~output:(obj2 (req "packed" bytes) (req "gas" Gas.encoding))
        ~query:RPC_query.empty
        RPC_path.(path / "pack_data")

    let run_operation =
      RPC_service.post_service
        ~description:"Run an operation without signature checks"
        ~query:RPC_query.empty
        ~input:
          (obj2
             (req "operation" Operation.encoding)
             (req "chain_id" Chain_id.encoding))
        ~output:Apply_results.operation_data_and_metadata_encoding
        RPC_path.(path / "run_operation")

    let entrypoint_type =
      RPC_service.post_service
        ~description:"Return the type of the given entrypoint"
        ~query:RPC_query.empty
        ~input:
          (obj2
             (req "script" Script.expr_encoding)
             (dft "entrypoint" string "default"))
        ~output:(obj1 (req "entrypoint_type" Script.expr_encoding))
        RPC_path.(path / "entrypoint")

    let list_entrypoints =
      RPC_service.post_service
        ~description:"Return the list of entrypoints of the given script"
        ~query:RPC_query.empty
        ~input:(obj1 (req "script" Script.expr_encoding))
        ~output:
          (obj2
             (dft
                "unreachable"
                (Data_encoding.list
                   (obj1
                      (req
                         "path"
                         (Data_encoding.list
                            Michelson_v1_primitives.prim_encoding))))
                [])
             (req "entrypoints" (assoc Script.expr_encoding)))
        RPC_path.(path / "entrypoints")
  end

  let register () =
    let open Services_registration in
    let originate_dummy_contract ctxt script =
      let ctxt = Contract.init_origination_nonce ctxt Operation_hash.zero in
      Contract.fresh_contract_from_current_nonce ctxt
      >>=? fun (ctxt, dummy_contract) ->
      let balance =
        match Tez.of_mutez 4_000_000_000_000L with
        | Some balance ->
            balance
        | None ->
            assert false
      in
      Contract.originate
        ctxt
        dummy_contract
        ~balance
        ~delegate:None
        ~script:(script, None)
      >>=? fun ctxt -> return (ctxt, dummy_contract)
    in
    register0
      S.run_code
      (fun ctxt
           ()
           ( code,
             storage,
             parameter,
             amount,
             chain_id,
             source,
             payer,
             gas,
             entrypoint )
           ->
        let storage = Script.lazy_expr storage in
        let code = Script.lazy_expr code in
        originate_dummy_contract ctxt {storage; code}
        >>=? fun (ctxt, dummy_contract) ->
        let (source, payer) =
          match (source, payer) with
          | (Some source, Some payer) ->
              (source, payer)
          | (Some source, None) ->
              (source, source)
          | (None, Some payer) ->
              (payer, payer)
          | (None, None) ->
              (dummy_contract, dummy_contract)
        in
        let gas =
          match gas with
          | Some gas ->
              gas
          | None ->
              Constants.hard_gas_limit_per_operation ctxt
        in
        let ctxt = Gas.set_limit ctxt gas in
        let step_constants =
          let open Script_interpreter in
          {source; payer; self = dummy_contract; amount; chain_id}
        in
        Script_interpreter.execute
          ctxt
          Readable
          step_constants
          ~script:{storage; code}
          ~entrypoint
          ~parameter
        >>=? fun {Script_interpreter.storage; operations; big_map_diff; _} ->
        return (storage, operations, big_map_diff)) ;
    register0
      S.trace_code
      (fun ctxt
           ()
           ( code,
             storage,
             parameter,
             amount,
             chain_id,
             source,
             payer,
             gas,
             entrypoint )
           ->
        let storage = Script.lazy_expr storage in
        let code = Script.lazy_expr code in
        originate_dummy_contract ctxt {storage; code}
        >>=? fun (ctxt, dummy_contract) ->
        let (source, payer) =
          match (source, payer) with
          | (Some source, Some payer) ->
              (source, payer)
          | (Some source, None) ->
              (source, source)
          | (None, Some payer) ->
              (payer, payer)
          | (None, None) ->
              (dummy_contract, dummy_contract)
        in
        let gas =
          match gas with
          | Some gas ->
              gas
          | None ->
              Constants.hard_gas_limit_per_operation ctxt
        in
        let ctxt = Gas.set_limit ctxt gas in
        let step_constants =
          let open Script_interpreter in
          {source; payer; self = dummy_contract; amount; chain_id}
        in
        Script_interpreter.trace
          ctxt
          Readable
          step_constants
          ~script:{storage; code}
          ~entrypoint
          ~parameter
        >>=? fun ( {Script_interpreter.storage; operations; big_map_diff; _},
                   trace ) ->
        return (storage, operations, trace, big_map_diff)) ;
    register0 S.typecheck_code (fun ctxt () (expr, maybe_gas) ->
        let ctxt =
          match maybe_gas with
          | None ->
              Gas.set_unlimited ctxt
          | Some gas ->
              Gas.set_limit ctxt gas
        in
        Script_ir_translator.typecheck_code ctxt expr
        >>=? fun (res, ctxt) -> return (res, Gas.level ctxt)) ;
    register0 S.typecheck_data (fun ctxt () (data, ty, maybe_gas) ->
        let ctxt =
          match maybe_gas with
          | None ->
              Gas.set_unlimited ctxt
          | Some gas ->
              Gas.set_limit ctxt gas
        in
        Script_ir_translator.typecheck_data ctxt (data, ty)
        >>=? fun ctxt -> return (Gas.level ctxt)) ;
    register0 S.pack_data (fun ctxt () (expr, typ, maybe_gas) ->
        let open Script_ir_translator in
        let ctxt =
          match maybe_gas with
          | None ->
              Gas.set_unlimited ctxt
          | Some gas ->
              Gas.set_limit ctxt gas
        in
        Lwt.return (parse_packable_ty ctxt ~legacy:true (Micheline.root typ))
        >>=? fun (Ex_ty typ, ctxt) ->
        parse_data ctxt ~legacy:true typ (Micheline.root expr)
        >>=? fun (data, ctxt) ->
        Script_ir_translator.pack_data ctxt typ data
        >>=? fun (bytes, ctxt) -> return (bytes, Gas.level ctxt)) ;
    register0
      S.run_operation
      (fun ctxt
           ()
           ({shell; protocol_data = Operation_data protocol_data}, chain_id)
           ->
        (* this code is a duplicate of Apply without signature check *)
        let partial_precheck_manager_contents (type kind) ctxt
            (op : kind Kind.manager contents) : context tzresult Lwt.t =
          let (Manager_operation
                {source; fee; counter; operation; gas_limit; storage_limit}) =
            op
          in
          Lwt.return (Gas.check_limit ctxt gas_limit)
          >>=? fun () ->
          let ctxt = Gas.set_limit ctxt gas_limit in
          Lwt.return (Fees.check_storage_limit ctxt storage_limit)
          >>=? fun () ->
          Contract.must_be_allocated ctxt (Contract.implicit_contract source)
          >>=? fun () ->
          Contract.check_counter_increment ctxt source counter
          >>=? fun () ->
          ( match operation with
          | Reveal pk ->
              Contract.reveal_manager_key ctxt source pk
          | Transaction {parameters; _} ->
              (* Here the data comes already deserialized, so we need to fake the deserialization to mimic apply *)
              let arg_bytes =
                Data_encoding.Binary.to_bytes_exn
                  Script.lazy_expr_encoding
                  parameters
              in
              let arg =
                match
                  Data_encoding.Binary.of_bytes
                    Script.lazy_expr_encoding
                    arg_bytes
                with
                | Some arg ->
                    arg
                | None ->
                    assert false
              in
              (* Fail quickly if not enough gas for minimal deserialization cost *)
              Lwt.return
              @@ record_trace Apply.Gas_quota_exceeded_init_deserialize
              @@ Gas.check_enough ctxt (Script.minimal_deserialize_cost arg)
              >>=? fun () ->
              (* Fail if not enough gas for complete deserialization cost *)
              trace Apply.Gas_quota_exceeded_init_deserialize
              @@ Script.force_decode ctxt arg
              >>|? fun (_arg, ctxt) -> ctxt
          | Origination {script; _} ->
              (* Here the data comes already deserialized, so we need to fake the deserialization to mimic apply *)
              let script_bytes =
                Data_encoding.Binary.to_bytes_exn Script.encoding script
              in
              let script =
                match
                  Data_encoding.Binary.of_bytes Script.encoding script_bytes
                with
                | Some script ->
                    script
                | None ->
                    assert false
              in
              (* Fail quickly if not enough gas for minimal deserialization cost *)
              Lwt.return
              @@ record_trace Apply.Gas_quota_exceeded_init_deserialize
              @@ ( Gas.consume
                     ctxt
                     (Script.minimal_deserialize_cost script.code)
                 >>? fun ctxt ->
                 Gas.check_enough
                   ctxt
                   (Script.minimal_deserialize_cost script.storage) )
              >>=? fun () ->
              (* Fail if not enough gas for complete deserialization cost *)
              trace Apply.Gas_quota_exceeded_init_deserialize
              @@ Script.force_decode ctxt script.code
              >>=? fun (_code, ctxt) ->
              trace Apply.Gas_quota_exceeded_init_deserialize
              @@ Script.force_decode ctxt script.storage
              >>|? fun (_storage, ctxt) -> ctxt
          | _ ->
              return ctxt )
          >>=? fun ctxt ->
          Contract.get_manager_key ctxt source
          >>=? fun _public_key ->
          (* signature check unplugged from here *)
          Contract.increment_counter ctxt source
          >>=? fun ctxt ->
          Contract.spend ctxt (Contract.implicit_contract source) fee
          >>=? fun ctxt -> return ctxt
        in
        let rec partial_precheck_manager_contents_list :
            type kind.
            Alpha_context.t ->
            kind Kind.manager contents_list ->
            context tzresult Lwt.t =
         fun ctxt contents_list ->
          match contents_list with
          | Single (Manager_operation _ as op) ->
              partial_precheck_manager_contents ctxt op
          | Cons ((Manager_operation _ as op), rest) ->
              partial_precheck_manager_contents ctxt op
              >>=? fun ctxt -> partial_precheck_manager_contents_list ctxt rest
        in
        let return contents =
          return
            ( Operation_data protocol_data,
              Apply_results.Operation_metadata {contents} )
        in
        let operation : _ operation = {shell; protocol_data} in
        let hash = Operation.hash {shell; protocol_data} in
        let ctxt = Contract.init_origination_nonce ctxt hash in
        let baker = Signature.Public_key_hash.zero in
        match protocol_data.contents with
        | Single (Manager_operation _) as op ->
            partial_precheck_manager_contents_list ctxt op
            >>=? fun ctxt ->
            Apply.apply_manager_contents_list ctxt Optimized baker chain_id op
            >>= fun (_ctxt, result) -> return result
        | Cons (Manager_operation _, _) as op ->
            partial_precheck_manager_contents_list ctxt op
            >>=? fun ctxt ->
            Apply.apply_manager_contents_list ctxt Optimized baker chain_id op
            >>= fun (_ctxt, result) -> return result
        | _ ->
            Apply.apply_contents_list
              ctxt
              chain_id
              Optimized
              shell.branch
              baker
              operation
              operation.protocol_data.contents
            >>=? fun (_ctxt, result) -> return result) ;
    register0 S.entrypoint_type (fun ctxt () (expr, entrypoint) ->
        let ctxt = Gas.set_unlimited ctxt in
        let legacy = false in
        let open Script_ir_translator in
        Lwt.return
          ( parse_toplevel ~legacy expr
          >>? fun (arg_type, _, _, root_name) ->
          parse_ty
            ctxt
            ~legacy
            ~allow_big_map:true
            ~allow_operation:false
            ~allow_contract:true
            arg_type
          >>? fun (Ex_ty arg_type, _) ->
          Script_ir_translator.find_entrypoint ~root_name arg_type entrypoint
          )
        >>=? fun (_f, Ex_ty ty) ->
        unparse_ty ctxt ty
        >>=? fun (ty_node, _) -> return (Micheline.strip_locations ty_node)) ;
    register0 S.list_entrypoints (fun ctxt () expr ->
        let ctxt = Gas.set_unlimited ctxt in
        let legacy = false in
        let open Script_ir_translator in
        Lwt.return
          ( parse_toplevel ~legacy expr
          >>? fun (arg_type, _, _, root_name) ->
          parse_ty
            ctxt
            ~legacy
            ~allow_big_map:true
            ~allow_operation:false
            ~allow_contract:true
            arg_type
          >>? fun (Ex_ty arg_type, _) ->
          Script_ir_translator.list_entrypoints ~root_name arg_type ctxt )
        >>=? fun (unreachable_entrypoint, map) ->
        return
          ( unreachable_entrypoint,
            Entrypoints_map.fold
              (fun entry (_, ty) acc ->
                (entry, Micheline.strip_locations ty) :: acc)
              map
              [] ))

  let run_code ctxt block code
      (storage, input, amount, chain_id, source, payer, gas, entrypoint) =
    RPC_context.make_call0
      S.run_code
      ctxt
      block
      ()
      (code, storage, input, amount, chain_id, source, payer, gas, entrypoint)

  let trace_code ctxt block code
      (storage, input, amount, chain_id, source, payer, gas, entrypoint) =
    RPC_context.make_call0
      S.trace_code
      ctxt
      block
      ()
      (code, storage, input, amount, chain_id, source, payer, gas, entrypoint)

  let typecheck_code ctxt block =
    RPC_context.make_call0 S.typecheck_code ctxt block ()

  let typecheck_data ctxt block =
    RPC_context.make_call0 S.typecheck_data ctxt block ()

  let pack_data ctxt block = RPC_context.make_call0 S.pack_data ctxt block ()

  let run_operation ctxt block =
    RPC_context.make_call0 S.run_operation ctxt block ()

  let entrypoint_type ctxt block =
    RPC_context.make_call0 S.entrypoint_type ctxt block ()

  let list_entrypoints ctxt block =
    RPC_context.make_call0 S.list_entrypoints ctxt block ()
end

module Forge = struct
  module S = struct
    open Data_encoding

    let path = RPC_path.(path / "forge")

    let operations =
      RPC_service.post_service
        ~description:"Forge an operation"
        ~query:RPC_query.empty
        ~input:Operation.unsigned_encoding
        ~output:bytes
        RPC_path.(path / "operations")

    let empty_proof_of_work_nonce =
      MBytes.of_string
        (String.make Constants_repr.proof_of_work_nonce_size '\000')

    let protocol_data =
      RPC_service.post_service
        ~description:"Forge the protocol-specific part of a block header"
        ~query:RPC_query.empty
        ~input:
          (obj3
             (req "priority" uint16)
             (opt "nonce_hash" Nonce_hash.encoding)
             (dft
                "proof_of_work_nonce"
                (Fixed.bytes Alpha_context.Constants.proof_of_work_nonce_size)
                empty_proof_of_work_nonce))
        ~output:(obj1 (req "protocol_data" bytes))
        RPC_path.(path / "protocol_data")
  end

  let register () =
    let open Services_registration in
    register0_noctxt S.operations (fun () (shell, proto) ->
        return
          (Data_encoding.Binary.to_bytes_exn
             Operation.unsigned_encoding
             (shell, proto))) ;
    register0_noctxt
      S.protocol_data
      (fun () (priority, seed_nonce_hash, proof_of_work_nonce) ->
        return
          (Data_encoding.Binary.to_bytes_exn
             Block_header.contents_encoding
             {priority; seed_nonce_hash; proof_of_work_nonce}))

  module Manager = struct
    let operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee
        ~gas_limit ~storage_limit operations =
      Contract_services.manager_key ctxt block source
      >>= function
      | Error _ as e ->
          Lwt.return e
      | Ok revealed ->
          let ops =
            List.map
              (fun (Manager operation) ->
                Contents
                  (Manager_operation
                     {
                       source;
                       counter;
                       operation;
                       fee;
                       gas_limit;
                       storage_limit;
                     }))
              operations
          in
          let ops =
            match (sourcePubKey, revealed) with
            | (None, _) | (_, Some _) ->
                ops
            | (Some pk, None) ->
                let operation = Reveal pk in
                Contents
                  (Manager_operation
                     {
                       source;
                       counter;
                       operation;
                       fee;
                       gas_limit;
                       storage_limit;
                     })
                :: ops
          in
          RPC_context.make_call0
            S.operations
            ctxt
            block
            ()
            ({branch}, Operation.of_list ops)

    let reveal ctxt block ~branch ~source ~sourcePubKey ~counter ~fee () =
      operations
        ctxt
        block
        ~branch
        ~source
        ~sourcePubKey
        ~counter
        ~fee
        ~gas_limit:Z.zero
        ~storage_limit:Z.zero
        []

    let transaction ctxt block ~branch ~source ?sourcePubKey ~counter ~amount
        ~destination ?(entrypoint = "default") ?parameters ~gas_limit
        ~storage_limit ~fee () =
      let parameters =
        Option.unopt_map
          ~f:Script.lazy_expr
          ~default:Script.unit_parameter
          parameters
      in
      operations
        ctxt
        block
        ~branch
        ~source
        ?sourcePubKey
        ~counter
        ~fee
        ~gas_limit
        ~storage_limit
        [Manager (Transaction {amount; parameters; destination; entrypoint})]

    let origination ctxt block ~branch ~source ?sourcePubKey ~counter ~balance
        ?delegatePubKey ~script ~gas_limit ~storage_limit ~fee () =
      operations
        ctxt
        block
        ~branch
        ~source
        ?sourcePubKey
        ~counter
        ~fee
        ~gas_limit
        ~storage_limit
        [ Manager
            (Origination
               {
                 delegate = delegatePubKey;
                 script;
                 credit = balance;
                 preorigination = None;
               }) ]

    let delegation ctxt block ~branch ~source ?sourcePubKey ~counter ~fee
        delegate =
      operations
        ctxt
        block
        ~branch
        ~source
        ?sourcePubKey
        ~counter
        ~fee
        ~gas_limit:Z.zero
        ~storage_limit:Z.zero
        [Manager (Delegation delegate)]
  end

  let operation ctxt block ~branch operation =
    RPC_context.make_call0
      S.operations
      ctxt
      block
      ()
      ({branch}, Contents_list (Single operation))

  let endorsement ctxt b ~branch ~level () =
    operation ctxt b ~branch (Endorsement {level})

  let proposals ctxt b ~branch ~source ~period ~proposals () =
    operation ctxt b ~branch (Proposals {source; period; proposals})

  let ballot ctxt b ~branch ~source ~period ~proposal ~ballot () =
    operation ctxt b ~branch (Ballot {source; period; proposal; ballot})

  let seed_nonce_revelation ctxt block ~branch ~level ~nonce () =
    operation ctxt block ~branch (Seed_nonce_revelation {level; nonce})

  let double_baking_evidence ctxt block ~branch ~bh1 ~bh2 () =
    operation ctxt block ~branch (Double_baking_evidence {bh1; bh2})

  let double_endorsement_evidence ctxt block ~branch ~op1 ~op2 () =
    operation ctxt block ~branch (Double_endorsement_evidence {op1; op2})

  let empty_proof_of_work_nonce =
    MBytes.of_string
      (String.make Constants_repr.proof_of_work_nonce_size '\000')

  let protocol_data ctxt block ~priority ?seed_nonce_hash
      ?(proof_of_work_nonce = empty_proof_of_work_nonce) () =
    RPC_context.make_call0
      S.protocol_data
      ctxt
      block
      ()
      (priority, seed_nonce_hash, proof_of_work_nonce)
end

module Parse = struct
  module S = struct
    open Data_encoding

    let path = RPC_path.(path / "parse")

    let operations =
      RPC_service.post_service
        ~description:"Parse operations"
        ~query:RPC_query.empty
        ~input:
          (obj2
             (req "operations" (list (dynamic_size Operation.raw_encoding)))
             (opt "check_signature" bool))
        ~output:(list (dynamic_size Operation.encoding))
        RPC_path.(path / "operations")

    let block =
      RPC_service.post_service
        ~description:"Parse a block"
        ~query:RPC_query.empty
        ~input:Block_header.raw_encoding
        ~output:Block_header.protocol_data_encoding
        RPC_path.(path / "block")
  end

  let parse_protocol_data protocol_data =
    match
      Data_encoding.Binary.of_bytes
        Block_header.protocol_data_encoding
        protocol_data
    with
    | None ->
        failwith "Cant_parse_protocol_data"
    | Some protocol_data ->
        return protocol_data

  let register () =
    let open Services_registration in
    register0 S.operations (fun _ctxt () (operations, check) ->
        map_s
          (fun raw ->
            Lwt.return (parse_operation raw)
            >>=? fun op ->
            ( match check with
            | Some true ->
                return_unit (* FIXME *)
            (* I.check_signature ctxt *)
            (* op.protocol_data.signature op.shell op.protocol_data.contents *)
            | Some false | None ->
                return_unit )
            >>|? fun () -> op)
          operations) ;
    register0_noctxt S.block (fun () raw_block ->
        parse_protocol_data raw_block.protocol_data)

  let operations ctxt block ?check operations =
    RPC_context.make_call0 S.operations ctxt block () (operations, check)

  let block ctxt block shell protocol_data =
    RPC_context.make_call0
      S.block
      ctxt
      block
      ()
      ({shell; protocol_data} : Block_header.raw)
end

module S = struct
  open Data_encoding

  type level_query = {offset : int32}

  let level_query : level_query RPC_query.t =
    let open RPC_query in
    query (fun offset -> {offset})
    |+ field "offset" RPC_arg.int32 0l (fun t -> t.offset)
    |> seal

  let current_level =
    RPC_service.get_service
      ~description:
        "Returns the level of the interrogated block, or the one of a block \
         located `offset` blocks after in the chain (or before when \
         negative). For instance, the next block if `offset` is 1."
      ~query:level_query
      ~output:Level.encoding
      RPC_path.(path / "current_level")

  let levels_in_current_cycle =
    RPC_service.get_service
      ~description:"Levels of a cycle"
      ~query:level_query
      ~output:
        (obj2 (req "first" Raw_level.encoding) (req "last" Raw_level.encoding))
      RPC_path.(path / "levels_in_current_cycle")
end

let register () =
  Scripts.register () ;
  Forge.register () ;
  Parse.register () ;
  let open Services_registration in
  register0 S.current_level (fun ctxt q () ->
      let level = Level.current ctxt in
      return (Level.from_raw ctxt ~offset:q.offset level.level)) ;
  register0 S.levels_in_current_cycle (fun ctxt q () ->
      let levels = Level.levels_in_current_cycle ctxt ~offset:q.offset () in
      match levels with
      | [] ->
          raise Not_found
      | _ ->
          let first = List.hd (List.rev levels) in
          let last = List.hd levels in
          return (first.level, last.level))

let current_level ctxt ?(offset = 0l) block =
  RPC_context.make_call0 S.current_level ctxt block {offset} ()

let levels_in_current_cycle ctxt ?(offset = 0l) block =
  RPC_context.make_call0 S.levels_in_current_cycle ctxt block {offset} ()
helpers_services_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "operation.cannot_parse" % string "Cannot parse operation" % string
    "The operation is ill-formed or for another protocol version" % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "The operation cannot be parsed" % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "The operation cannot be parsed" % string))) Data_encoding.unit
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_parse_operation
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_parse_operation).

Definition parse_operation
  (op : Tezos_raw_protocol_alpha.Alpha_context.Operation.raw)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    Tezos_raw_protocol_alpha.Alpha_context.packed_operation :=
  match
    Data_encoding.Binary.of_bytes Operation.protocol_data_encoding (proto op)
    with
  | Some protocol_data =>
    ok {| shell := shell op; protocol_data := protocol_data |}
  | None =>
    error
      Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_parse_operation
  end.

Definition path
  : Tezos_protocol_environment_alpha__Environment.RPC_path.path
    Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
    Tezos_protocol_environment_alpha__Environment.Updater.rpc_context :=
  op_div open_root "helpers" % string.

Module Scripts.
  Module S.
    Import Data_encoding.
    
    Definition path
      : Tezos_protocol_environment_alpha__Environment.RPC_path.path
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context :=
      op_div path "scripts" % string.
    
    Definition run_code_input_encoding
      : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Tez.t *
          Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
          * option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
          option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
          option Tezos_protocol_environment_alpha__Environment.Z.t * string) :=
      obj9 (req None None "script" % string Script.expr_encoding)
        (req None None "storage" % string Script.expr_encoding)
        (req None None "input" % string Script.expr_encoding)
        (req None None "amount" % string Tez.encoding)
        (req None None "chain_id" % string
          Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.encoding))
        (opt None None "source" % string Contract.encoding)
        (opt None None "payer" % string Contract.encoding)
        (opt None None "gas" % string z)
        (dft None None "entrypoint" % string string "default" % string).
    
    Definition trace_encoding
      : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
        (list
          (Tezos_raw_protocol_alpha.Alpha_context.Script.location *
            Tezos_raw_protocol_alpha.Alpha_context.Gas.t *
            list
              (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
                option string))) :=
      op_atat
        (let arg := def "scripted.trace" % string in
        fun eta => arg None None eta)
        (op_atat
          (let arg := list in
          fun eta => arg None eta)
          (obj3 (req None None "location" % string Script.location_encoding)
            (req None None "gas" % string Gas.encoding)
            (req None None "stack" % string
              (list None
                (obj2 (req None None "item" % string Script.expr_encoding)
                  (opt None None "annot" % string string)))))).
    
    Definition run_code
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        variant
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Tez.t *
          Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
          * option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
          option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
          option Tezos_protocol_environment_alpha__Environment.Z.t * string)
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          list Tezos_raw_protocol_alpha__Alpha_context.packed_internal_operation
          * option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff) :=
      RPC_service.post_service
        (Some "Run a piece of code in the current context" % string)
        RPC_query.empty run_code_input_encoding
        (obj3 (req None None "storage" % string Script.expr_encoding)
          (req None None "operations" % string
            (list None Operation.internal_operation_encoding))
          (opt None None "big_map_diff" % string Contract.big_map_diff_encoding))
        (op_div path "run_code" % string).
    
    Definition trace_code
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        variant
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Tez.t *
          Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
          * option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
          option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
          option Tezos_protocol_environment_alpha__Environment.Z.t * string)
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          list Tezos_raw_protocol_alpha__Alpha_context.packed_internal_operation
          *
          list
            (Tezos_raw_protocol_alpha.Alpha_context.Script.location *
              Tezos_raw_protocol_alpha.Alpha_context.Gas.t *
              list
                (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
                  option string)) *
          option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff) :=
      RPC_service.post_service
        (Some
          "Run a piece of code in the current context, keeping a trace" % string)
        RPC_query.empty run_code_input_encoding
        (obj4 (req None None "storage" % string Script.expr_encoding)
          (req None None "operations" % string
            (list None Operation.internal_operation_encoding))
          (req None None "trace" % string trace_encoding)
          (opt None None "big_map_diff" % string Contract.big_map_diff_encoding))
        (op_div path "trace_code" % string).
    
    Definition typecheck_code
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        variant
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          option Tezos_protocol_environment_alpha__Environment.Z.t)
        (list
          (Tezos_raw_protocol_alpha.Alpha_context.Script.location *
            (list
              (Tezos_raw_protocol_alpha.Alpha_context.Script.expr * list string)
              *
              list
                (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
                  list string))) * Tezos_raw_protocol_alpha.Alpha_context.Gas.t) :=
      RPC_service.post_service
        (Some "Typecheck a piece of code in the current context" % string)
        RPC_query.empty
        (obj2 (req None None "program" % string Script.expr_encoding)
          (opt None None "gas" % string z))
        (obj2
          (req None None "type_map" % string
            Script_tc_errors_registration.type_map_enc)
          (req None None "gas" % string Gas.encoding))
        (op_div path "typecheck_code" % string).
    
    Definition typecheck_data
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        variant
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          option Tezos_protocol_environment_alpha__Environment.Z.t)
        Tezos_raw_protocol_alpha.Alpha_context.Gas.t :=
      RPC_service.post_service
        (Some
          "Check that some data expression is well formed and of a given type in the current context"
            % string) RPC_query.empty
        (obj3 (req None None "data" % string Script.expr_encoding)
          (req None None "type" % string Script.expr_encoding)
          (opt None None "gas" % string z))
        (obj1 (req None None "gas" % string Gas.encoding))
        (op_div path "typecheck_data" % string).
    
    Definition pack_data
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        variant
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          option Tezos_protocol_environment_alpha__Environment.Z.t)
        (Tezos_protocol_environment_alpha__Environment.MBytes.t *
          Tezos_raw_protocol_alpha.Alpha_context.Gas.t) :=
      RPC_service.post_service
        (Some
          "Computes the serialized version of some data expression using the same algorithm as script instruction PACK"
            % string) RPC_query.empty
        (obj3 (req None None "data" % string Script.expr_encoding)
          (req None None "type" % string Script.expr_encoding)
          (opt None None "gas" % string z))
        (obj2 (req None None "packed" % string bytes)
          (req None None "gas" % string Gas.encoding))
        (op_div path "pack_data" % string).
    
    Definition run_operation
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        variant
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (Tezos_raw_protocol_alpha.Alpha_context.Operation.packed *
          Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
        (Tezos_raw_protocol_alpha.Alpha_context.Operation.packed_protocol_data *
          Tezos_raw_protocol_alpha.Apply_results.packed_operation_metadata) :=
      RPC_service.post_service
        (Some "Run an operation without signature checks" % string)
        RPC_query.empty
        (obj2 (req None None "operation" % string Operation.encoding)
          (req None None "chain_id" % string
            Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.encoding)))
        Apply_results.operation_data_and_metadata_encoding
        (op_div path "run_operation" % string).
    
    Definition entrypoint_type
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        variant
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr * string)
        Tezos_raw_protocol_alpha.Alpha_context.Script.expr :=
      RPC_service.post_service
        (Some "Return the type of the given entrypoint" % string)
        RPC_query.empty
        (obj2 (req None None "script" % string Script.expr_encoding)
          (dft None None "entrypoint" % string string "default" % string))
        (obj1 (req None None "entrypoint_type" % string Script.expr_encoding))
        (op_div path "entrypoint" % string).
    
    Definition list_entrypoints
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        variant
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        Tezos_raw_protocol_alpha.Alpha_context.Script.expr
        (list (list Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) *
          list (string * Tezos_raw_protocol_alpha.Alpha_context.Script.expr)) :=
      RPC_service.post_service
        (Some "Return the list of entrypoints of the given script" % string)
        RPC_query.empty
        (obj1 (req None None "script" % string Script.expr_encoding))
        (obj2
          (dft None None "unreachable" % string
            (Data_encoding.list None
              (obj1
                (req None None "path" % string
                  (Data_encoding.list None Michelson_v1_primitives.prim_encoding))))
            [])
          (req None None "entrypoints" % string (assoc Script.expr_encoding)))
        (op_div path "entrypoints" % string).
  End S.
  
  Definition register (function_parameter : unit) : unit :=
    let 'tt := function_parameter in
    let originate_dummy_contract
      (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context) (script :
      Tezos_raw_protocol_alpha__Alpha_context.Script.t)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha__Alpha_context.context *
            Tezos_raw_protocol_alpha.Alpha_context.Contract.t)) :=
      let ctxt :=
        Contract.init_origination_nonce ctxt
          Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.zero)
        in
      op_gtgteqquestion (Contract.fresh_contract_from_current_nonce ctxt)
        (fun function_parameter =>
          let '(ctxt, dummy_contract) := function_parameter in
          let balance :=
            match
              Tez.of_mutez
                (* ❌ Constant of type int64 is converted to int *)
                4000000000000 with
            | Some balance => balance
            | None =>
              (* ❌ Assert instruction is not handled. *)
              assert false
            end in
          op_gtgteqquestion
            (Contract.originate ctxt dummy_contract balance (script, None) None)
            (fun ctxt => __return (ctxt, dummy_contract))) in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ :=
      register0 S.run_code
        (fun ctxt =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let
                '(code, storage, parameter, amount, chain_id, source, payer,
                  gas, entrypoint) := function_parameter in
              let storage := Script.lazy_expr storage in
              let code := Script.lazy_expr code in
              op_gtgteqquestion
                (originate_dummy_contract ctxt
                  {| code := code; storage := storage |})
                (fun function_parameter =>
                  let '(ctxt, dummy_contract) := function_parameter in
                  let '(source, payer) :=
                    match (source, payer) with
                    | (Some source, Some payer) => (source, payer)
                    | (Some source, None) => (source, source)
                    | (None, Some payer) => (payer, payer)
                    | (None, None) => (dummy_contract, dummy_contract)
                    end in
                  let gas :=
                    match gas with
                    | Some gas => gas
                    | None => Constants.hard_gas_limit_per_operation ctxt
                    end in
                  let ctxt := Gas.set_limit ctxt gas in
                  let step_constants :=
                    {| source := source; payer := payer; self := dummy_contract;
                      amount := amount; chain_id := chain_id |} in
                  op_gtgteqquestion
                    (Script_interpreter.execute ctxt
                      Tezos_raw_protocol_alpha.Script_ir_translator.Readable
                      step_constants {| code := code; storage := storage |}
                      entrypoint parameter)
                    (fun function_parameter =>
                      let '{|
                        Script_interpreter.storage := storage;
                          Script_interpreter.big_map_diff := big_map_diff;
                          Script_interpreter.operations := operations
                          |} := function_parameter in
                      __return (storage, operations, big_map_diff)))) in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ :=
      register0 S.trace_code
        (fun ctxt =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let
                '(code, storage, parameter, amount, chain_id, source, payer,
                  gas, entrypoint) := function_parameter in
              let storage := Script.lazy_expr storage in
              let code := Script.lazy_expr code in
              op_gtgteqquestion
                (originate_dummy_contract ctxt
                  {| code := code; storage := storage |})
                (fun function_parameter =>
                  let '(ctxt, dummy_contract) := function_parameter in
                  let '(source, payer) :=
                    match (source, payer) with
                    | (Some source, Some payer) => (source, payer)
                    | (Some source, None) => (source, source)
                    | (None, Some payer) => (payer, payer)
                    | (None, None) => (dummy_contract, dummy_contract)
                    end in
                  let gas :=
                    match gas with
                    | Some gas => gas
                    | None => Constants.hard_gas_limit_per_operation ctxt
                    end in
                  let ctxt := Gas.set_limit ctxt gas in
                  let step_constants :=
                    {| source := source; payer := payer; self := dummy_contract;
                      amount := amount; chain_id := chain_id |} in
                  op_gtgteqquestion
                    (Script_interpreter.trace ctxt
                      Tezos_raw_protocol_alpha.Script_ir_translator.Readable
                      step_constants {| code := code; storage := storage |}
                      entrypoint parameter)
                    (fun function_parameter =>
                      let
                        '({|
                          Script_interpreter.storage := storage;
                            Script_interpreter.big_map_diff := big_map_diff;
                            Script_interpreter.operations := operations
                            |}, trace) := function_parameter in
                      __return (storage, operations, trace, big_map_diff)))) in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ :=
      register0 S.typecheck_code
        (fun ctxt =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let '(expr, maybe_gas) := function_parameter in
              let ctxt :=
                match maybe_gas with
                | None => Gas.set_unlimited ctxt
                | Some gas => Gas.set_limit ctxt gas
                end in
              op_gtgteqquestion (Script_ir_translator.typecheck_code ctxt expr)
                (fun function_parameter =>
                  let '(res, ctxt) := function_parameter in
                  __return (res, (Gas.level ctxt)))) in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ :=
      register0 S.typecheck_data
        (fun ctxt =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let '(data, ty, maybe_gas) := function_parameter in
              let ctxt :=
                match maybe_gas with
                | None => Gas.set_unlimited ctxt
                | Some gas => Gas.set_limit ctxt gas
                end in
              op_gtgteqquestion
                (Script_ir_translator.typecheck_data None ctxt (data, ty))
                (fun ctxt => __return (Gas.level ctxt))) in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ :=
      register0 S.pack_data
        (fun ctxt =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let '(expr, typ, maybe_gas) := function_parameter in
              let ctxt :=
                match maybe_gas with
                | None => Gas.set_unlimited ctxt
                | Some gas => Gas.set_limit ctxt gas
                end in
              op_gtgteqquestion
                (Lwt.__return (parse_packable_ty ctxt true (Micheline.root typ)))
                (fun function_parameter =>
                  let
                    '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_ty typ,
                      ctxt) := function_parameter in
                  op_gtgteqquestion
                    (parse_data None ctxt true typ (Micheline.root expr))
                    (fun function_parameter =>
                      let '(data, ctxt) := function_parameter in
                      op_gtgteqquestion
                        (Script_ir_translator.pack_data ctxt typ data)
                        (fun function_parameter =>
                          let '(bytes, ctxt) := function_parameter in
                          __return (string, (Gas.level ctxt)))))) in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ :=
      register0 S.run_operation
        (fun ctxt =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let
                '({|
                  shell := shell;
                    protocol_data :=
                      Tezos_raw_protocol_alpha.Alpha_context.Operation_data
                        protocol_data
                    |}, chain_id) := function_parameter in
              let partial_precheck_manager_contents {A : Type}
                (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context) (op :
                Tezos_raw_protocol_alpha.Alpha_context.contents
                  (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager A))
                : Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                    Tezos_raw_protocol_alpha.Alpha_context.context) :=
                let
                  'Tezos_raw_protocol_alpha.Alpha_context.Manager_operation {|
                    source := source;
                      fee := fee;
                      counter := counter;
                      operation := operation;
                      gas_limit := gas_limit;
                      storage_limit := storage_limit
                      |} := op in
                op_gtgteqquestion
                  (Lwt.__return (Gas.check_limit ctxt gas_limit))
                  (fun function_parameter =>
                    let 'tt := function_parameter in
                    let ctxt := Gas.set_limit ctxt gas_limit in
                    op_gtgteqquestion
                      (Lwt.__return
                        (Fees.check_storage_limit ctxt storage_limit))
                      (fun function_parameter =>
                        let 'tt := function_parameter in
                        op_gtgteqquestion
                          (Contract.must_be_allocated ctxt
                            (Contract.implicit_contract source))
                          (fun function_parameter =>
                            let 'tt := function_parameter in
                            op_gtgteqquestion
                              (Contract.check_counter_increment ctxt source
                                counter)
                              (fun function_parameter =>
                                let 'tt := function_parameter in
                                op_gtgteqquestion
                                  match operation with
                                  |
                                    Tezos_raw_protocol_alpha.Alpha_context.Reveal
                                      pk =>
                                    Contract.reveal_manager_key ctxt source pk
                                  |
                                    Tezos_raw_protocol_alpha.Alpha_context.Transaction
                                      {| parameters := parameters |} =>
                                    let arg_bytes :=
                                      Data_encoding.Binary.to_bytes_exn
                                        Script.lazy_expr_encoding parameters in
                                    let arg :=
                                      match
                                        Data_encoding.Binary.of_bytes
                                          Script.lazy_expr_encoding arg_bytes
                                        with
                                      | Some arg => arg
                                      | None =>
                                        (* ❌ Assert instruction is not handled. *)
                                        assert false
                                      end in
                                    op_gtgteqquestion
                                      (op_atat Lwt.__return
                                        (op_atat
                                          (record_trace
                                            Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
                                          (Gas.check_enough ctxt
                                            (Script.minimal_deserialize_cost arg))))
                                      (fun function_parameter =>
                                        let 'tt := function_parameter in
                                        op_gtgtpipequestion
                                          (op_atat
                                            (trace
                                              Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
                                            (Script.force_decode ctxt arg))
                                          (fun function_parameter =>
                                            let '(_arg, ctxt) :=
                                              function_parameter in
                                            ctxt))
                                  |
                                    Tezos_raw_protocol_alpha.Alpha_context.Origination
                                      {| script := script |} =>
                                    let script_bytes :=
                                      Data_encoding.Binary.to_bytes_exn
                                        Script.encoding script in
                                    let script :=
                                      match
                                        Data_encoding.Binary.of_bytes
                                          Script.encoding script_bytes with
                                      | Some script => script
                                      | None =>
                                        (* ❌ Assert instruction is not handled. *)
                                        assert false
                                      end in
                                    op_gtgteqquestion
                                      (op_atat Lwt.__return
                                        (op_atat
                                          (record_trace
                                            Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
                                          (op_gtgtquestion
                                            (Gas.consume ctxt
                                              (Script.minimal_deserialize_cost
                                                (code script)))
                                            (fun ctxt =>
                                              Gas.check_enough ctxt
                                                (Script.minimal_deserialize_cost
                                                  (storage script))))))
                                      (fun function_parameter =>
                                        let 'tt := function_parameter in
                                        op_gtgteqquestion
                                          (op_atat
                                            (trace
                                              Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
                                            (Script.force_decode ctxt
                                              (code script)))
                                          (fun function_parameter =>
                                            let '(_code, ctxt) :=
                                              function_parameter in
                                            op_gtgtpipequestion
                                              (op_atat
                                                (trace
                                                  Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_quota_exceeded_init_deserialize)
                                                (Script.force_decode ctxt
                                                  (storage script)))
                                              (fun function_parameter =>
                                                let '(_storage, ctxt) :=
                                                  function_parameter in
                                                ctxt)))
                                  | _ => __return ctxt
                                  end
                                  (fun ctxt =>
                                    op_gtgteqquestion
                                      (Contract.get_manager_key ctxt source)
                                      (fun _public_key =>
                                        op_gtgteqquestion
                                          (Contract.increment_counter ctxt
                                            source)
                                          (fun ctxt =>
                                            op_gtgteqquestion
                                              (Contract.spend ctxt
                                                (Contract.implicit_contract
                                                  source) fee)
                                              (fun ctxt => __return ctxt))))))))
                in
              let fix partial_precheck_manager_contents_list {kind : Type}
                (ctxt : Tezos_raw_protocol_alpha.Alpha_context.t) (contents_list
                :
                Tezos_raw_protocol_alpha.Alpha_context.contents_list
                  (Tezos_raw_protocol_alpha.Alpha_context.Kind.manager kind))
                : Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                    Tezos_raw_protocol_alpha.Alpha_context.context) :=
                match contents_list with
                |
                  Tezos_raw_protocol_alpha.Alpha_context.Single
                    ((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _)
                      as op) => partial_precheck_manager_contents ctxt op
                |
                  Tezos_raw_protocol_alpha.Alpha_context.Cons
                    ((Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _)
                      as op) rest =>
                  op_gtgteqquestion (partial_precheck_manager_contents ctxt op)
                    (fun ctxt =>
                      partial_precheck_manager_contents_list ctxt rest)
                end in
              let __return {A : Type}
                (contents :
                Tezos_raw_protocol_alpha.Apply_results.contents_result_list A)
                : Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                    (Tezos_raw_protocol_alpha.Alpha_context.packed_protocol_data
                      *
                      Tezos_raw_protocol_alpha.Apply_results.packed_operation_metadata)) :=
                __return
                  ((Tezos_raw_protocol_alpha.Alpha_context.Operation_data
                    protocol_data),
                    (Tezos_raw_protocol_alpha.Apply_results.Operation_metadata
                      {| contents := contents |})) in
              let operation :=
                {| shell := shell; protocol_data := protocol_data |} in
              let hash :=
                Operation.hash
                  {| shell := shell; protocol_data := protocol_data |} in
              let ctxt := Contract.init_origination_nonce ctxt hash in
              let baker := Signature.Public_key_hash.zero in
              match contents protocol_data with
              |
                (Tezos_raw_protocol_alpha.Alpha_context.Single
                  (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _))
                  as op =>
                op_gtgteqquestion
                  (partial_precheck_manager_contents_list ctxt op)
                  (fun ctxt =>
                    op_gtgteq
                      (Apply.apply_manager_contents_list ctxt
                        Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                        baker chain_id op)
                      (fun function_parameter =>
                        let '(_ctxt, result) := function_parameter in
                        __return result))
              |
                (Tezos_raw_protocol_alpha.Alpha_context.Cons
                  (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation _) _)
                  as op =>
                op_gtgteqquestion
                  (partial_precheck_manager_contents_list ctxt op)
                  (fun ctxt =>
                    op_gtgteq
                      (Apply.apply_manager_contents_list ctxt
                        Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                        baker chain_id op)
                      (fun function_parameter =>
                        let '(_ctxt, result) := function_parameter in
                        __return result))
              | _ =>
                op_gtgteqquestion
                  (Apply.apply_contents_list ctxt chain_id
                    Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                    (branch shell) baker operation
                    (contents (protocol_data operation)))
                  (fun function_parameter =>
                    let '(_ctxt, result) := function_parameter in
                    __return result)
              end) in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ :=
      register0 S.entrypoint_type
        (fun ctxt =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let '(expr, entrypoint) := function_parameter in
              let ctxt := Gas.set_unlimited ctxt in
              let legacy := false in
              op_gtgteqquestion
                (Lwt.__return
                  (op_gtgtquestion (parse_toplevel legacy expr)
                    (fun function_parameter =>
                      let '(arg_type, _, _, root_name) := function_parameter in
                      op_gtgtquestion
                        (parse_ty ctxt legacy true false true arg_type)
                        (fun function_parameter =>
                          let
                            '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_ty
                              arg_type, _) := function_parameter in
                          Script_ir_translator.find_entrypoint arg_type
                            root_name entrypoint))))
                (fun function_parameter =>
                  let
                    '(_f, Tezos_raw_protocol_alpha.Script_ir_translator.Ex_ty ty) :=
                    function_parameter in
                  op_gtgteqquestion (unparse_ty ctxt ty)
                    (fun function_parameter =>
                      let '(ty_node, _) := function_parameter in
                      __return (Micheline.strip_locations ty_node)))) in
    register0 S.list_entrypoints
      (fun ctxt =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun expr =>
            let ctxt := Gas.set_unlimited ctxt in
            let legacy := false in
            op_gtgteqquestion
              (Lwt.__return
                (op_gtgtquestion (parse_toplevel legacy expr)
                  (fun function_parameter =>
                    let '(arg_type, _, _, root_name) := function_parameter in
                    op_gtgtquestion
                      (parse_ty ctxt legacy true false true arg_type)
                      (fun function_parameter =>
                        let
                          '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_ty
                            arg_type, _) := function_parameter in
                        Script_ir_translator.list_entrypoints arg_type ctxt
                          root_name))))
              (fun function_parameter =>
                let '(unreachable_entrypoint, map) := function_parameter in
                __return
                  (unreachable_entrypoint,
                    (Entrypoints_map.fold
                      (fun entry =>
                        fun function_parameter =>
                          let '(_, ty) := function_parameter in
                          fun acc =>
                            cons (entry, (Micheline.strip_locations ty)) acc)
                      map [])))).
  
  Definition run_code {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (block : D) (code : Tezos_raw_protocol_alpha.Alpha_context.Script.expr)
    (function_parameter :
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
        Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
        Tezos_raw_protocol_alpha.Alpha_context.Tez.t *
        Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
        * option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
        option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
        option Tezos_protocol_environment_alpha__Environment.Z.t * string)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          list Tezos_raw_protocol_alpha__Alpha_context.packed_internal_operation
          * option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff)) :=
    let '(storage, input, amount, chain_id, source, payer, gas, entrypoint) :=
      function_parameter in
    RPC_context.make_call0 S.run_code ctxt block tt
      (code, storage, input, amount, chain_id, source, payer, gas, entrypoint).
  
  Definition trace_code {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (block : D) (code : Tezos_raw_protocol_alpha.Alpha_context.Script.expr)
    (function_parameter :
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
        Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
        Tezos_raw_protocol_alpha.Alpha_context.Tez.t *
        Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
        * option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
        option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
        option Tezos_protocol_environment_alpha__Environment.Z.t * string)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          list Tezos_raw_protocol_alpha__Alpha_context.packed_internal_operation
          *
          list
            (Tezos_raw_protocol_alpha.Alpha_context.Script.location *
              Tezos_raw_protocol_alpha.Alpha_context.Gas.t *
              list
                (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
                  option string)) *
          option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff)) :=
    let '(storage, input, amount, chain_id, source, payer, gas, entrypoint) :=
      function_parameter in
    RPC_context.make_call0 S.trace_code ctxt block tt
      (code, storage, input, amount, chain_id, source, payer, gas, entrypoint).
  
  Definition typecheck_code {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (block : D)
    : Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      option Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          (list
            (Tezos_raw_protocol_alpha.Alpha_context.Script.location *
              (list
                (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
                  list string) *
                list
                  (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
                    list string))) *
            Tezos_raw_protocol_alpha.Alpha_context.Gas.t)) :=
    RPC_context.make_call0 S.typecheck_code ctxt block tt.
  
  Definition typecheck_data {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (block : D)
    : Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      option Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          Tezos_raw_protocol_alpha.Alpha_context.Gas.t) :=
    RPC_context.make_call0 S.typecheck_data ctxt block tt.
  
  Definition pack_data {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (block : D)
    : Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      option Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          (Tezos_protocol_environment_alpha__Environment.MBytes.t *
            Tezos_raw_protocol_alpha.Alpha_context.Gas.t)) :=
    RPC_context.make_call0 S.pack_data ctxt block tt.
  
  Definition run_operation {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (block : D)
    : Tezos_raw_protocol_alpha.Alpha_context.Operation.packed *
      Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
      ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          (Tezos_raw_protocol_alpha.Alpha_context.Operation.packed_protocol_data
            * Tezos_raw_protocol_alpha.Apply_results.packed_operation_metadata)) :=
    RPC_context.make_call0 S.run_operation ctxt block tt.
  
  Definition entrypoint_type {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (block : D)
    : Tezos_raw_protocol_alpha.Alpha_context.Script.expr * string ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr) :=
    RPC_context.make_call0 S.entrypoint_type ctxt block tt.
  
  Definition list_entrypoints {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (block : D)
    : Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          (list (list Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) *
            list (string * Tezos_raw_protocol_alpha.Alpha_context.Script.expr))) :=
    RPC_context.make_call0 S.list_entrypoints ctxt block tt.
End Scripts.

Module Forge.
  Module S.
    Import Data_encoding.
    
    Definition path
      : Tezos_protocol_environment_alpha__Environment.RPC_path.path
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context :=
      op_div path "forge" % string.
    
    Definition operations
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        variant
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (Tezos_protocol_environment_alpha__Environment.Operation.shell_header *
          Tezos_raw_protocol_alpha__Alpha_context.packed_contents_list)
        Tezos_protocol_environment_alpha__Environment.MBytes.t :=
      RPC_service.post_service (Some "Forge an operation" % string)
        RPC_query.empty Operation.unsigned_encoding bytes
        (op_div path "operations" % string).
    
    Definition empty_proof_of_work_nonce
      : Tezos_protocol_environment_alpha__Environment.MBytes.t :=
      MBytes.of_string
        (String.make Constants_repr.proof_of_work_nonce_size "000" % char).
    
    Definition protocol_data
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        variant
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (Z * option Tezos_raw_protocol_alpha.Nonce_hash.t *
          Tezos_protocol_environment_alpha__Environment.MBytes.t)
        Tezos_protocol_environment_alpha__Environment.MBytes.t :=
      RPC_service.post_service
        (Some "Forge the protocol-specific part of a block header" % string)
        RPC_query.empty
        (obj3 (req None None "priority" % string uint16)
          (opt None None "nonce_hash" % string Nonce_hash.encoding)
          (dft None None "proof_of_work_nonce" % string
            (Fixed.bytes Alpha_context.Constants.proof_of_work_nonce_size)
            empty_proof_of_work_nonce))
        (obj1 (req None None "protocol_data" % string bytes))
        (op_div path "protocol_data" % string).
  End S.
  
  Definition register (function_parameter : unit) : unit :=
    let 'tt := function_parameter in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ :=
      register0_noctxt S.operations
        (fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let '(shell, proto) := function_parameter in
            __return
              (Data_encoding.Binary.to_bytes_exn Operation.unsigned_encoding
                (shell, proto))) in
    register0_noctxt S.protocol_data
      (fun function_parameter =>
        let 'tt := function_parameter in
        fun function_parameter =>
          let '(priority, seed_nonce_hash, proof_of_work_nonce) :=
            function_parameter in
          __return
            (Data_encoding.Binary.to_bytes_exn Block_header.contents_encoding
              {| priority := priority; seed_nonce_hash := seed_nonce_hash;
                proof_of_work_nonce := proof_of_work_nonce |})).
  
  Module Manager.
    Definition operations {D E G I K L a b c i o q : Type}
      (ctxt :
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
          D ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (E * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q
            i o ->
            D ->
              a ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (G * a * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) q i o ->
              D ->
                a ->
                  b ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (I * a * b * q * i * o)) *
              (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
                variant
                Tezos_protocol_environment_alpha__Environment.RPC_context.t
                (((Tezos_protocol_environment_alpha__Environment.RPC_context.t *
                  a) * b) * c) q i o ->
                D ->
                  a ->
                    b ->
                      c ->
                        q ->
                          i ->
                            Tezos_protocol_environment_alpha__Environment.Lwt.t
                              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                                o)) * (K * a * b * c * q * i * o)) * L)))) * L *
          D) (block : D)
      (branch :
        Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
      (source : Tezos_raw_protocol_alpha.Alpha_context.public_key_hash)
      (sourcePubKey :
        option
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
      (counter : Tezos_raw_protocol_alpha.Alpha_context.counter)
      (fee : Tezos_raw_protocol_alpha.Alpha_context.Tez.tez)
      (gas_limit : Tezos_protocol_environment_alpha__Environment.Z.t)
      (storage_limit : Tezos_protocol_environment_alpha__Environment.Z.t)
      (operations :
        list Tezos_raw_protocol_alpha.Alpha_context.packed_manager_operation)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Pervasives.result
          Tezos_protocol_environment_alpha__Environment.MBytes.t
          (list
            Tezos_protocol_environment_alpha__Environment.Error_monad.shell_error)) :=
      op_gtgteq (Contract_services.manager_key ctxt block source)
        (fun function_parameter =>
          match function_parameter with
          |
            (Tezos_protocol_environment_alpha__Environment.Pervasives.Error _)
              as e => Lwt.__return e
          | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok revealed
            =>
            let ops :=
              List.map
                (fun function_parameter =>
                  let
                    'Tezos_raw_protocol_alpha.Alpha_context.Manager operation :=
                    function_parameter in
                  Tezos_raw_protocol_alpha.Alpha_context.Contents
                    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation
                      {| source := source; fee := fee; counter := counter;
                        operation := operation; gas_limit := gas_limit;
                        storage_limit := storage_limit |})) operations in
            let ops :=
              match (sourcePubKey, revealed) with
              | (None, _) | (_, Some _) => ops
              | (Some pk, None) =>
                let operation :=
                  Tezos_raw_protocol_alpha.Alpha_context.Reveal pk in
                cons
                  (Tezos_raw_protocol_alpha.Alpha_context.Contents
                    (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation
                      {| source := source; fee := fee; counter := counter;
                        operation := operation; gas_limit := gas_limit;
                        storage_limit := storage_limit |})) ops
              end in
            RPC_context.make_call0 S.operations ctxt block tt
              ({| branch := branch |}, (Operation.of_list ops))
          end).
    
    Definition reveal {D E G I K L a b c i o q : Type}
      (ctxt :
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
          D ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (E * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q
            i o ->
            D ->
              a ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (G * a * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) q i o ->
              D ->
                a ->
                  b ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (I * a * b * q * i * o)) *
              (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
                variant
                Tezos_protocol_environment_alpha__Environment.RPC_context.t
                (((Tezos_protocol_environment_alpha__Environment.RPC_context.t *
                  a) * b) * c) q i o ->
                D ->
                  a ->
                    b ->
                      c ->
                        q ->
                          i ->
                            Tezos_protocol_environment_alpha__Environment.Lwt.t
                              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                                o)) * (K * a * b * c * q * i * o)) * L)))) * L *
          D) (block : D)
      (branch :
        Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
      (source : Tezos_raw_protocol_alpha.Alpha_context.public_key_hash)
      (sourcePubKey :
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
      (counter : Tezos_raw_protocol_alpha.Alpha_context.counter)
      (fee : Tezos_raw_protocol_alpha.Alpha_context.Tez.tez)
      (function_parameter : unit)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Pervasives.result
          Tezos_protocol_environment_alpha__Environment.MBytes.t
          (list
            Tezos_protocol_environment_alpha__Environment.Error_monad.shell_error)) :=
      let 'tt := function_parameter in
      operations ctxt block branch source (Some sourcePubKey) counter fee Z.zero
        Z.zero [].
    
    Definition transaction {D E G I K L a b c i o q : Type}
      (ctxt :
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
          D ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (E * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q
            i o ->
            D ->
              a ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (G * a * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) q i o ->
              D ->
                a ->
                  b ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (I * a * b * q * i * o)) *
              (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
                variant
                Tezos_protocol_environment_alpha__Environment.RPC_context.t
                (((Tezos_protocol_environment_alpha__Environment.RPC_context.t *
                  a) * b) * c) q i o ->
                D ->
                  a ->
                    b ->
                      c ->
                        q ->
                          i ->
                            Tezos_protocol_environment_alpha__Environment.Lwt.t
                              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                                o)) * (K * a * b * c * q * i * o)) * L)))) * L *
          D) (block : D)
      (branch :
        Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
      (source : Tezos_raw_protocol_alpha.Alpha_context.public_key_hash)
      (sourcePubKey :
        option
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
      (counter : Tezos_raw_protocol_alpha.Alpha_context.counter)
      (amount : Tezos_raw_protocol_alpha.Alpha_context.Tez.tez)
      (destination : Tezos_raw_protocol_alpha.Alpha_context.Contract.contract)
      (op_staroptstar : option string)
      : option Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
        Tezos_protocol_environment_alpha__Environment.Z.t ->
          Tezos_protocol_environment_alpha__Environment.Z.t ->
            Tezos_raw_protocol_alpha.Alpha_context.Tez.tez ->
              unit ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Pervasives.result
                    Tezos_protocol_environment_alpha__Environment.MBytes.t
                    (list
                      Tezos_protocol_environment_alpha__Environment.Error_monad.shell_error)) :=
      let entrypoint :=
        match op_staroptstar with
        | Some op_starsthstar => op_starsthstar
        | None => "default" % string
        end in
      fun parameters =>
        fun gas_limit =>
          fun storage_limit =>
            fun fee =>
              fun function_parameter =>
                let 'tt := function_parameter in
                let parameters :=
                  Option.unopt_map Script.lazy_expr Script.unit_parameter
                    parameters in
                operations ctxt block branch source sourcePubKey counter fee
                  gas_limit storage_limit
                  (cons
                    (Tezos_raw_protocol_alpha.Alpha_context.Manager
                      (Tezos_raw_protocol_alpha.Alpha_context.Transaction
                        {| amount := amount; parameters := parameters;
                          entrypoint := entrypoint; destination := destination
                          |})) []).
    
    Definition origination {D E G I K L a b c i o q : Type}
      (ctxt :
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
          D ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (E * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q
            i o ->
            D ->
              a ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (G * a * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) q i o ->
              D ->
                a ->
                  b ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (I * a * b * q * i * o)) *
              (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
                variant
                Tezos_protocol_environment_alpha__Environment.RPC_context.t
                (((Tezos_protocol_environment_alpha__Environment.RPC_context.t *
                  a) * b) * c) q i o ->
                D ->
                  a ->
                    b ->
                      c ->
                        q ->
                          i ->
                            Tezos_protocol_environment_alpha__Environment.Lwt.t
                              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                                o)) * (K * a * b * c * q * i * o)) * L)))) * L *
          D) (block : D)
      (branch :
        Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
      (source : Tezos_raw_protocol_alpha.Alpha_context.public_key_hash)
      (sourcePubKey :
        option
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
      (counter : Tezos_raw_protocol_alpha.Alpha_context.counter)
      (balance : Tezos_raw_protocol_alpha.Alpha_context.Tez.tez)
      (delegatePubKey :
        option
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      (script : Tezos_raw_protocol_alpha.Alpha_context.Script.t)
      (gas_limit : Tezos_protocol_environment_alpha__Environment.Z.t)
      (storage_limit : Tezos_protocol_environment_alpha__Environment.Z.t)
      (fee : Tezos_raw_protocol_alpha.Alpha_context.Tez.tez)
      (function_parameter : unit)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Pervasives.result
          Tezos_protocol_environment_alpha__Environment.MBytes.t
          (list
            Tezos_protocol_environment_alpha__Environment.Error_monad.shell_error)) :=
      let 'tt := function_parameter in
      operations ctxt block branch source sourcePubKey counter fee gas_limit
        storage_limit
        (cons
          (Tezos_raw_protocol_alpha.Alpha_context.Manager
            (Tezos_raw_protocol_alpha.Alpha_context.Origination
              {| delegate := delegatePubKey; script := script;
                credit := balance; preorigination := None |})) []).
    
    Definition delegation {D E G I K L a b c i o q : Type}
      (ctxt :
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
          D ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (E * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q
            i o ->
            D ->
              a ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (G * a * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) q i o ->
              D ->
                a ->
                  b ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (I * a * b * q * i * o)) *
              (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
                variant
                Tezos_protocol_environment_alpha__Environment.RPC_context.t
                (((Tezos_protocol_environment_alpha__Environment.RPC_context.t *
                  a) * b) * c) q i o ->
                D ->
                  a ->
                    b ->
                      c ->
                        q ->
                          i ->
                            Tezos_protocol_environment_alpha__Environment.Lwt.t
                              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                                o)) * (K * a * b * c * q * i * o)) * L)))) * L *
          D) (block : D)
      (branch :
        Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
      (source : Tezos_raw_protocol_alpha.Alpha_context.public_key_hash)
      (sourcePubKey :
        option
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
      (counter : Tezos_raw_protocol_alpha.Alpha_context.counter)
      (fee : Tezos_raw_protocol_alpha.Alpha_context.Tez.tez)
      (delegate :
        option
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Pervasives.result
          Tezos_protocol_environment_alpha__Environment.MBytes.t
          (list
            Tezos_protocol_environment_alpha__Environment.Error_monad.shell_error)) :=
      operations ctxt block branch source sourcePubKey counter fee Z.zero Z.zero
        (cons
          (Tezos_raw_protocol_alpha.Alpha_context.Manager
            (Tezos_raw_protocol_alpha.Alpha_context.Delegation delegate)) []).
  End Manager.
  
  Definition operation {D E G I K L M a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (block : D)
    (branch :
      Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
    (operation : Tezos_raw_protocol_alpha.Alpha_context.contents M)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t) :=
    RPC_context.make_call0 S.operations ctxt block tt
      ({| branch := branch |},
        (Tezos_raw_protocol_alpha.Alpha_context.Contents_list
          (Tezos_raw_protocol_alpha.Alpha_context.Single operation))).
  
  Definition endorsement {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (b : D)
    (branch :
      Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
    (level : Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t)
    (function_parameter : unit)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t) :=
    let 'tt := function_parameter in
    operation ctxt b branch
      (Tezos_raw_protocol_alpha.Alpha_context.Endorsement {| level := level |}).
  
  Definition proposals {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (b : D)
    (branch :
      Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
    (source :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
    (period : Tezos_raw_protocol_alpha.Alpha_context.Voting_period.t)
    (proposals :
      list
        Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
    (function_parameter : unit)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t) :=
    let 'tt := function_parameter in
    operation ctxt b branch
      (Tezos_raw_protocol_alpha.Alpha_context.Proposals
        {| source := source; period := period; proposals := proposals |}).
  
  Definition ballot {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (b : D)
    (branch :
      Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
    (source :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
    (period : Tezos_raw_protocol_alpha.Alpha_context.Voting_period.t)
    (proposal :
      Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
    (ballot : Tezos_raw_protocol_alpha.Alpha_context.Vote.ballot)
    (function_parameter : unit)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t) :=
    let 'tt := function_parameter in
    operation ctxt b branch
      (Tezos_raw_protocol_alpha.Alpha_context.Ballot
        {| source := source; period := period; proposal := proposal;
          ballot := ballot |}).
  
  Definition seed_nonce_revelation {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (block : D)
    (branch :
      Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
    (level : Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t)
    (nonce : Tezos_raw_protocol_alpha.Alpha_context.Nonce.t)
    (function_parameter : unit)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t) :=
    let 'tt := function_parameter in
    operation ctxt block branch
      (Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation
        {| level := level; nonce := nonce |}).
  
  Definition double_baking_evidence {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (block : D)
    (branch :
      Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
    (bh1 : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
    (bh2 : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
    (function_parameter : unit)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t) :=
    let 'tt := function_parameter in
    operation ctxt block branch
      (Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence
        {| bh1 := bh1; bh2 := bh2 |}).
  
  Definition double_endorsement_evidence {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (block : D)
    (branch :
      Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
    (op1 :
      Tezos_raw_protocol_alpha.Alpha_context.operation
        Tezos_raw_protocol_alpha.Alpha_context.Kind.endorsement)
    (op2 :
      Tezos_raw_protocol_alpha.Alpha_context.operation
        Tezos_raw_protocol_alpha.Alpha_context.Kind.endorsement)
    (function_parameter : unit)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.MBytes.t) :=
    let 'tt := function_parameter in
    operation ctxt block branch
      (Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence
        {| op1 := op1; op2 := op2 |}).
  
  Definition empty_proof_of_work_nonce
    : Tezos_protocol_environment_alpha__Environment.MBytes.t :=
    MBytes.of_string
      (String.make Constants_repr.proof_of_work_nonce_size "000" % char).
  
  Definition protocol_data {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (block : D) (priority : Z)
    (seed_nonce_hash : option Tezos_raw_protocol_alpha.Nonce_hash.t)
    (op_staroptstar :
      option Tezos_protocol_environment_alpha__Environment.MBytes.t)
    : unit ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          Tezos_protocol_environment_alpha__Environment.MBytes.t) :=
    let proof_of_work_nonce :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => empty_proof_of_work_nonce
      end in
    fun function_parameter =>
      let 'tt := function_parameter in
      RPC_context.make_call0 S.protocol_data ctxt block tt
        (priority, seed_nonce_hash, proof_of_work_nonce).
End Forge.

Module Parse.
  Module S.
    Import Data_encoding.
    
    Definition path
      : Tezos_protocol_environment_alpha__Environment.RPC_path.path
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context :=
      op_div path "parse" % string.
    
    Definition operations
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        variant
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        (list Tezos_raw_protocol_alpha.Alpha_context.Operation.raw * option bool)
        (list Tezos_raw_protocol_alpha.Alpha_context.Operation.packed) :=
      RPC_service.post_service (Some "Parse operations" % string)
        RPC_query.empty
        (obj2
          (req None None "operations" % string
            (list None (dynamic_size None Operation.raw_encoding)))
          (opt None None "check_signature" % string bool))
        (list None (dynamic_size None Operation.encoding))
        (op_div path "operations" % string).
    
    Definition block
      : Tezos_protocol_environment_alpha__Environment.RPC_service.service
        variant
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
        Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
        Tezos_raw_protocol_alpha.Alpha_context.Block_header.raw
        Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data :=
      RPC_service.post_service (Some "Parse a block" % string) RPC_query.empty
        Block_header.raw_encoding Block_header.protocol_data_encoding
        (op_div path "block" % string).
  End S.
  
  Definition parse_protocol_data
    (protocol_data : Tezos_protocol_environment_alpha__Environment.MBytes.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data) :=
    match
      Data_encoding.Binary.of_bytes Block_header.protocol_data_encoding
        protocol_data with
    | None => failwith "Cant_parse_protocol_data" % string
    | Some protocol_data => __return protocol_data
    end.
  
  Definition register (function_parameter : unit) : unit :=
    let 'tt := function_parameter in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ :=
      register0 S.operations
        (fun _ctxt =>
          fun function_parameter =>
            let 'tt := function_parameter in
            fun function_parameter =>
              let '(operations, check) := function_parameter in
              map_s
                (fun raw =>
                  op_gtgteqquestion (Lwt.__return (parse_operation raw))
                    (fun op =>
                      op_gtgtpipequestion
                        match check with
                        | Some true => return_unit
                        | Some false | None => return_unit
                        end
                        (fun function_parameter =>
                          let 'tt := function_parameter in
                          op))) operations) in
    register0_noctxt S.block
      (fun function_parameter =>
        let 'tt := function_parameter in
        fun raw_block => parse_protocol_data (protocol_data raw_block)).
  
  Definition operations {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (block : D) (check : option bool)
    (operations : list Tezos_raw_protocol_alpha.Alpha_context.Operation.raw)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (list Tezos_raw_protocol_alpha.Alpha_context.Operation.packed)) :=
    RPC_context.make_call0 S.operations ctxt block tt (operations, check).
  
  Definition block {D E G I K L a b c i o q : Type}
    (ctxt :
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
        D ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (E * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i
          o ->
          D ->
            a ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (G * a * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
              b) q i o ->
            D ->
              a ->
                b ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (I * a * b * q * i * o)) *
            (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
              variant
              Tezos_protocol_environment_alpha__Environment.RPC_context.t
              (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
                * b) * c) q i o ->
              D ->
                a ->
                  b ->
                    c ->
                      q ->
                        i ->
                          Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                              o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
    (block : D)
    (shell :
      Tezos_protocol_environment_alpha__Environment.Block_header.shell_header)
    (protocol_data : Tezos_protocol_environment_alpha__Environment.MBytes.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data) :=
    RPC_context.make_call0 S.block ctxt block tt
      {| shell := shell; protocol_data := protocol_data |}.
End Parse.

Module S.
  Import Data_encoding.
  
  Record level_query := {
    offset : int32 }.
  
  Definition level_query
    : Tezos_protocol_environment_alpha__Environment.RPC_query.t level_query :=
    op_pipegt
      (op_pipeplus (query (fun offset => {| offset := offset |}))
        (field None "offset" % string RPC_arg.int32
          (* ❌ Constant of type int32 is converted to int *)
          0 (fun t => offset t))) seal.
  
  Definition current_level
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      level_query unit Tezos_raw_protocol_alpha.Alpha_context.Level.t :=
    RPC_service.get_service
      (Some
        "Returns the level of the interrogated block, or the one of a block located `offset` blocks after in the chain (or before when negative). For instance, the next block if `offset` is 1."
          % string) level_query Level.encoding
      (op_div path "current_level" % string).
  
  Definition levels_in_current_cycle
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      level_query unit
      (Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t *
        Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t) :=
    RPC_service.get_service (Some "Levels of a cycle" % string) level_query
      (obj2 (req None None "first" % string Raw_level.encoding)
        (req None None "last" % string Raw_level.encoding))
      (op_div path "levels_in_current_cycle" % string).
End S.

Definition register (function_parameter : unit) : unit :=
  let 'tt := function_parameter in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Scripts.register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Forge.register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Parse.register tt in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register0 S.current_level
      (fun ctxt =>
        fun q =>
          fun function_parameter =>
            let 'tt := function_parameter in
            let level := Level.current ctxt in
            __return (Level.from_raw ctxt (Some (offset q)) (level level))) in
  register0 S.levels_in_current_cycle
    (fun ctxt =>
      fun q =>
        fun function_parameter =>
          let 'tt := function_parameter in
          let levels := Level.levels_in_current_cycle ctxt (Some (offset q)) tt
            in
          match levels with
          | [] => raise OCaml.Not_found
          | _ =>
            let first := List.hd (List.rev levels) in
            let last := List.hd levels in
            __return ((level first), (level last))
          end).

Definition current_level {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (op_staroptstar : option int32)
  : D ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_raw_protocol_alpha.Alpha_context.Level.t) :=
  let offset :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None =>
      (* ❌ Constant of type int32 is converted to int *)
      0
    end in
  fun block =>
    RPC_context.make_call0 S.current_level ctxt block {| offset := offset |} tt.

Definition levels_in_current_cycle {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (op_staroptstar : option int32)
  : D ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t *
          Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t)) :=
  let offset :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None =>
      (* ❌ Constant of type int32 is converted to int *)
      0
    end in
  fun block =>
    RPC_context.make_call0 S.levels_in_current_cycle ctxt block
      {| offset := offset |} tt.
helpers_services.mli 474 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

type error += Cannot_parse_operation (* `Branch *)

val current_level :
  'a #RPC_context.simple -> ?offset:int32 -> 'a -> Level.t shell_tzresult Lwt.t

val levels_in_current_cycle :
  'a #RPC_context.simple ->
  ?offset:int32 ->
  'a ->
  (Raw_level.t * Raw_level.t) shell_tzresult Lwt.t

module Scripts : sig
  val run_code :
    'a #RPC_context.simple ->
    'a ->
    Script.expr ->
    Script.expr
    * Script.expr
    * Tez.t
    * Chain_id.t
    * Contract.t option
    * Contract.t option
    * Z.t option
    * string ->
    ( Script.expr
    * packed_internal_operation list
    * Contract.big_map_diff option )
    shell_tzresult
    Lwt.t

  val trace_code :
    'a #RPC_context.simple ->
    'a ->
    Script.expr ->
    Script.expr
    * Script.expr
    * Tez.t
    * Chain_id.t
    * Contract.t option
    * Contract.t option
    * Z.t option
    * string ->
    ( Script.expr
    * packed_internal_operation list
    * Script_interpreter.execution_trace
    * Contract.big_map_diff option )
    shell_tzresult
    Lwt.t

  val typecheck_code :
    'a #RPC_context.simple ->
    'a ->
    Script.expr * Z.t option ->
    (Script_tc_errors.type_map * Gas.t) shell_tzresult Lwt.t

  val typecheck_data :
    'a #RPC_context.simple ->
    'a ->
    Script.expr * Script.expr * Z.t option ->
    Gas.t shell_tzresult Lwt.t

  val pack_data :
    'a #RPC_context.simple ->
    'a ->
    Script.expr * Script.expr * Z.t option ->
    (MBytes.t * Gas.t) shell_tzresult Lwt.t

  val run_operation :
    'a #RPC_context.simple ->
    'a ->
    packed_operation * Chain_id.t ->
    (packed_protocol_data * Apply_results.packed_operation_metadata)
    shell_tzresult
    Lwt.t

  val entrypoint_type :
    'a #RPC_context.simple ->
    'a ->
    Script.expr * string ->
    Script.expr shell_tzresult Lwt.t

  val list_entrypoints :
    'a #RPC_context.simple ->
    'a ->
    Script.expr ->
    (Michelson_v1_primitives.prim list list * (string * Script.expr) list)
    shell_tzresult
    Lwt.t
end

module Forge : sig
  module Manager : sig
    val operations :
      'a #RPC_context.simple ->
      'a ->
      branch:Block_hash.t ->
      source:public_key_hash ->
      ?sourcePubKey:public_key ->
      counter:counter ->
      fee:Tez.t ->
      gas_limit:Z.t ->
      storage_limit:Z.t ->
      packed_manager_operation list ->
      MBytes.t shell_tzresult Lwt.t

    val reveal :
      'a #RPC_context.simple ->
      'a ->
      branch:Block_hash.t ->
      source:public_key_hash ->
      sourcePubKey:public_key ->
      counter:counter ->
      fee:Tez.t ->
      unit ->
      MBytes.t shell_tzresult Lwt.t

    val transaction :
      'a #RPC_context.simple ->
      'a ->
      branch:Block_hash.t ->
      source:public_key_hash ->
      ?sourcePubKey:public_key ->
      counter:counter ->
      amount:Tez.t ->
      destination:Contract.t ->
      ?entrypoint:string ->
      ?parameters:Script.expr ->
      gas_limit:Z.t ->
      storage_limit:Z.t ->
      fee:Tez.t ->
      unit ->
      MBytes.t shell_tzresult Lwt.t

    val origination :
      'a #RPC_context.simple ->
      'a ->
      branch:Block_hash.t ->
      source:public_key_hash ->
      ?sourcePubKey:public_key ->
      counter:counter ->
      balance:Tez.t ->
      ?delegatePubKey:public_key_hash ->
      script:Script.t ->
      gas_limit:Z.t ->
      storage_limit:Z.t ->
      fee:Tez.t ->
      unit ->
      MBytes.t shell_tzresult Lwt.t

    val delegation :
      'a #RPC_context.simple ->
      'a ->
      branch:Block_hash.t ->
      source:public_key_hash ->
      ?sourcePubKey:public_key ->
      counter:counter ->
      fee:Tez.t ->
      public_key_hash option ->
      MBytes.t shell_tzresult Lwt.t
  end

  val endorsement :
    'a #RPC_context.simple ->
    'a ->
    branch:Block_hash.t ->
    level:Raw_level.t ->
    unit ->
    MBytes.t shell_tzresult Lwt.t

  val proposals :
    'a #RPC_context.simple ->
    'a ->
    branch:Block_hash.t ->
    source:public_key_hash ->
    period:Voting_period.t ->
    proposals:Protocol_hash.t list ->
    unit ->
    MBytes.t shell_tzresult Lwt.t

  val ballot :
    'a #RPC_context.simple ->
    'a ->
    branch:Block_hash.t ->
    source:public_key_hash ->
    period:Voting_period.t ->
    proposal:Protocol_hash.t ->
    ballot:Vote.ballot ->
    unit ->
    MBytes.t shell_tzresult Lwt.t

  val seed_nonce_revelation :
    'a #RPC_context.simple ->
    'a ->
    branch:Block_hash.t ->
    level:Raw_level.t ->
    nonce:Nonce.t ->
    unit ->
    MBytes.t shell_tzresult Lwt.t

  val double_baking_evidence :
    'a #RPC_context.simple ->
    'a ->
    branch:Block_hash.t ->
    bh1:Block_header.t ->
    bh2:Block_header.t ->
    unit ->
    MBytes.t shell_tzresult Lwt.t

  val double_endorsement_evidence :
    'a #RPC_context.simple ->
    'a ->
    branch:Block_hash.t ->
    op1:Kind.endorsement operation ->
    op2:Kind.endorsement operation ->
    unit ->
    MBytes.t shell_tzresult Lwt.t

  val protocol_data :
    'a #RPC_context.simple ->
    'a ->
    priority:int ->
    ?seed_nonce_hash:Nonce_hash.t ->
    ?proof_of_work_nonce:MBytes.t ->
    unit ->
    MBytes.t shell_tzresult Lwt.t
end

module Parse : sig
  val operations :
    'a #RPC_context.simple ->
    'a ->
    ?check:bool ->
    Operation.raw list ->
    Operation.packed list shell_tzresult Lwt.t

  val block :
    'a #RPC_context.simple ->
    'a ->
    Block_header.shell_header ->
    MBytes.t ->
    Block_header.protocol_data shell_tzresult Lwt.t
end

val register : unit -> unit
helpers_services_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

extensible_type

Parameter current_level : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  option int32 ->
    a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          Tezos_raw_protocol_alpha.Alpha_context.Level.t).

Parameter levels_in_current_cycle : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  option int32 ->
    a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
          (Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t *
            Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t)).

Module Scripts.
  Parameter run_code : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
        Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Tez.t *
          Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
          * option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
          option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
          option Tezos_protocol_environment_alpha__Environment.Z.t * string ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
                list
                  Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation
                *
                option
                  Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff)).
  
  Parameter trace_code : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
        Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Tez.t *
          Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
          * option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
          option Tezos_raw_protocol_alpha.Alpha_context.Contract.t *
          option Tezos_protocol_environment_alpha__Environment.Z.t * string ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
                list
                  Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation
                * Tezos_raw_protocol_alpha.Script_interpreter.execution_trace *
                option
                  Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff)).
  
  Parameter typecheck_code : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
        option Tezos_protocol_environment_alpha__Environment.Z.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            (Tezos_raw_protocol_alpha.Script_tc_errors.type_map *
              Tezos_raw_protocol_alpha.Alpha_context.Gas.t)).
  
  Parameter typecheck_data : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
        Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
        option Tezos_protocol_environment_alpha__Environment.Z.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            Tezos_raw_protocol_alpha.Alpha_context.Gas.t).
  
  Parameter pack_data : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
        Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
        option Tezos_protocol_environment_alpha__Environment.Z.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            (Tezos_protocol_environment_alpha__Environment.MBytes.t *
              Tezos_raw_protocol_alpha.Alpha_context.Gas.t)).
  
  Parameter run_operation : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      Tezos_raw_protocol_alpha.Alpha_context.packed_operation *
        Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
        ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            (Tezos_raw_protocol_alpha.Alpha_context.packed_protocol_data *
              Tezos_raw_protocol_alpha.Apply_results.packed_operation_metadata)).
  
  Parameter entrypoint_type : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr * string ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            Tezos_raw_protocol_alpha.Alpha_context.Script.expr).
  
  Parameter list_entrypoints : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            (list (list Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) *
              list (string * Tezos_raw_protocol_alpha.Alpha_context.Script.expr))).
End Scripts.

Module Forge.
  Module Manager.
    Parameter operations : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        a ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          a ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            a ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a
      ->
      a ->
        Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
          ->
          Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
            option Tezos_raw_protocol_alpha.Alpha_context.public_key ->
              Tezos_raw_protocol_alpha.Alpha_context.counter ->
                Tezos_raw_protocol_alpha.Alpha_context.Tez.t ->
                  Tezos_protocol_environment_alpha__Environment.Z.t ->
                    Tezos_protocol_environment_alpha__Environment.Z.t ->
                      list
                        Tezos_raw_protocol_alpha.Alpha_context.packed_manager_operation
                        ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            Tezos_protocol_environment_alpha__Environment.MBytes.t).
    
    Parameter reveal : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        a ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          a ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            a ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a
      ->
      a ->
        Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
          ->
          Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
            Tezos_raw_protocol_alpha.Alpha_context.public_key ->
              Tezos_raw_protocol_alpha.Alpha_context.counter ->
                Tezos_raw_protocol_alpha.Alpha_context.Tez.t ->
                  unit ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        Tezos_protocol_environment_alpha__Environment.MBytes.t).
    
    Parameter transaction : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        a ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          a ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            a ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a
      ->
      a ->
        Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
          ->
          Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
            option Tezos_raw_protocol_alpha.Alpha_context.public_key ->
              Tezos_raw_protocol_alpha.Alpha_context.counter ->
                Tezos_raw_protocol_alpha.Alpha_context.Tez.t ->
                  Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
                    option string ->
                      option Tezos_raw_protocol_alpha.Alpha_context.Script.expr
                        ->
                        Tezos_protocol_environment_alpha__Environment.Z.t ->
                          Tezos_protocol_environment_alpha__Environment.Z.t ->
                            Tezos_raw_protocol_alpha.Alpha_context.Tez.t ->
                              unit ->
                                Tezos_protocol_environment_alpha__Environment.Lwt.t
                                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                                    Tezos_protocol_environment_alpha__Environment.MBytes.t).
    
    Parameter origination : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        a ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          a ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            a ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a
      ->
      a ->
        Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
          ->
          Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
            option Tezos_raw_protocol_alpha.Alpha_context.public_key ->
              Tezos_raw_protocol_alpha.Alpha_context.counter ->
                Tezos_raw_protocol_alpha.Alpha_context.Tez.t ->
                  option Tezos_raw_protocol_alpha.Alpha_context.public_key_hash
                    ->
                    Tezos_raw_protocol_alpha.Alpha_context.Script.t ->
                      Tezos_protocol_environment_alpha__Environment.Z.t ->
                        Tezos_protocol_environment_alpha__Environment.Z.t ->
                          Tezos_raw_protocol_alpha.Alpha_context.Tez.t ->
                            unit ->
                              Tezos_protocol_environment_alpha__Environment.Lwt.t
                                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                                  Tezos_protocol_environment_alpha__Environment.MBytes.t).
    
    Parameter delegation : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
      variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        a ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          a ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            a ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a
      ->
      a ->
        Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
          ->
          Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
            option Tezos_raw_protocol_alpha.Alpha_context.public_key ->
              Tezos_raw_protocol_alpha.Alpha_context.counter ->
                Tezos_raw_protocol_alpha.Alpha_context.Tez.t ->
                  option Tezos_raw_protocol_alpha.Alpha_context.public_key_hash
                    ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        Tezos_protocol_environment_alpha__Environment.MBytes.t).
  End Manager.
  
  Parameter endorsement : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
        ->
        Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t ->
          unit ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                Tezos_protocol_environment_alpha__Environment.MBytes.t).
  
  Parameter proposals : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
        ->
        Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
          Tezos_raw_protocol_alpha.Alpha_context.Voting_period.t ->
            list
              Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
              ->
              unit ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    Tezos_protocol_environment_alpha__Environment.MBytes.t).
  
  Parameter ballot : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
        ->
        Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
          Tezos_raw_protocol_alpha.Alpha_context.Voting_period.t ->
            Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
              ->
              Tezos_raw_protocol_alpha.Alpha_context.Vote.ballot ->
                unit ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      Tezos_protocol_environment_alpha__Environment.MBytes.t).
  
  Parameter seed_nonce_revelation : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
        ->
        Tezos_raw_protocol_alpha.Alpha_context.Raw_level.t ->
          Tezos_raw_protocol_alpha.Alpha_context.Nonce.t ->
            unit ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  Tezos_protocol_environment_alpha__Environment.MBytes.t).
  
  Parameter double_baking_evidence : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
        ->
        Tezos_raw_protocol_alpha.Alpha_context.Block_header.t ->
          Tezos_raw_protocol_alpha.Alpha_context.Block_header.t ->
            unit ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  Tezos_protocol_environment_alpha__Environment.MBytes.t).
  
  Parameter double_endorsement_evidence : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
        ->
        Tezos_raw_protocol_alpha.Alpha_context.operation
          Tezos_raw_protocol_alpha.Alpha_context.Kind.endorsement ->
          Tezos_raw_protocol_alpha.Alpha_context.operation
            Tezos_raw_protocol_alpha.Alpha_context.Kind.endorsement ->
            unit ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  Tezos_protocol_environment_alpha__Environment.MBytes.t).
  
  Parameter protocol_data : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      Z ->
        option Tezos_raw_protocol_alpha.Nonce_hash.t ->
          option Tezos_protocol_environment_alpha__Environment.MBytes.t ->
            unit ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  Tezos_protocol_environment_alpha__Environment.MBytes.t).
End Forge.

Module Parse.
  Parameter operations : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      option bool ->
        list Tezos_raw_protocol_alpha.Alpha_context.Operation.raw ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              (list Tezos_raw_protocol_alpha.Alpha_context.Operation.packed)).
  
  Parameter block : forall {_ a b c i o q variant : Type}, (((Tezos_protocol_environment_alpha__Environment.RPC_service.t
    variant Tezos_protocol_environment_alpha__Environment.RPC_context.t
    Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
    a ->
      q ->
        i ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              o)) * (_ * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
      a ->
        a ->
          q ->
            i ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                  o)) * (_ * a * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
        q i o ->
        a ->
          a ->
            b ->
              q ->
                i ->
                  Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                      o)) * (_ * a * b * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) *
            b) * c) q i o ->
          a ->
            a ->
              b ->
                c ->
                  q ->
                    i ->
                      Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                          o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
    a ->
      Tezos_raw_protocol_alpha.Alpha_context.Block_header.shell_header ->
        Tezos_protocol_environment_alpha__Environment.MBytes.t ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
              Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data).
End Parse.

Parameter register : unit -> unit.
init_storage.ml 3 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* This is the genesis protocol: initialise the state *)
let prepare_first_block ctxt ~typecheck ~level ~timestamp ~fitness =
  Raw_context.prepare_first_block ~level ~timestamp ~fitness ctxt
  >>=? fun (previous_protocol, ctxt) ->
  Storage.Big_map.Next.init ctxt
  >>=? fun ctxt ->
  match previous_protocol with
  | Genesis param ->
      Commitment_storage.init ctxt param.commitments
      >>=? fun ctxt ->
      Roll_storage.init ctxt
      >>=? fun ctxt ->
      Seed_storage.init ctxt
      >>=? fun ctxt ->
      Contract_storage.init ctxt
      >>=? fun ctxt ->
      Bootstrap_storage.init
        ctxt
        ~typecheck
        ?ramp_up_cycles:param.security_deposit_ramp_up_cycles
        ?no_reward_cycles:param.no_reward_cycles
        param.bootstrap_accounts
        param.bootstrap_contracts
      >>=? fun ctxt ->
      Roll_storage.init_first_cycles ctxt
      >>=? fun ctxt ->
      Vote_storage.init ctxt
      >>=? fun ctxt ->
      Storage.Block_priority.init ctxt 0
      >>=? fun ctxt ->
      Vote_storage.freeze_listings ctxt >>=? fun ctxt -> return ctxt
  | Alpha_previous ->
      return ctxt

let prepare ctxt ~level ~predecessor_timestamp ~timestamp ~fitness =
  Raw_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt
init_storage_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition prepare_first_block
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  (typecheck :
    Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_raw_protocol_alpha.Script_repr.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            ((Tezos_raw_protocol_alpha.Script_repr.t *
              option Tezos_raw_protocol_alpha.Contract_storage.big_map_diff) *
              Tezos_raw_protocol_alpha.Raw_context.t))) (level : int32)
  (timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (fitness :
    Tezos_protocol_environment_alpha__Environment.Fitness.(Tezos_protocol_environment_alpha__Environment.T.S.t))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteqquestion
    (Raw_context.prepare_first_block level timestamp fitness ctxt)
    (fun function_parameter =>
      let '(previous_protocol, ctxt) := function_parameter in
      op_gtgteqquestion (Storage.Big_map.Next.init ctxt)
        (fun ctxt =>
          match previous_protocol with
          | Tezos_raw_protocol_alpha.Raw_context.Genesis param =>
            op_gtgteqquestion (Commitment_storage.init ctxt (commitments param))
              (fun ctxt =>
                op_gtgteqquestion (Roll_storage.init ctxt)
                  (fun ctxt =>
                    op_gtgteqquestion (Seed_storage.init ctxt)
                      (fun ctxt =>
                        op_gtgteqquestion (Contract_storage.init ctxt)
                          (fun ctxt =>
                            op_gtgteqquestion
                              (Bootstrap_storage.init ctxt typecheck
                                (security_deposit_ramp_up_cycles param)
                                (no_reward_cycles param)
                                (bootstrap_accounts param)
                                (bootstrap_contracts param))
                              (fun ctxt =>
                                op_gtgteqquestion
                                  (Roll_storage.init_first_cycles ctxt)
                                  (fun ctxt =>
                                    op_gtgteqquestion (Vote_storage.init ctxt)
                                      (fun ctxt =>
                                        op_gtgteqquestion
                                          (Storage.Block_priority.init ctxt 0)
                                          (fun ctxt =>
                                            op_gtgteqquestion
                                              (Vote_storage.freeze_listings ctxt)
                                              (fun ctxt => __return ctxt)))))))))
          | Tezos_raw_protocol_alpha.Raw_context.Alpha_previous => __return ctxt
          end)).

Definition prepare
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  (level : Tezos_protocol_environment_alpha__Environment.Int32.t)
  (predecessor_timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (fitness :
    Tezos_protocol_environment_alpha__Environment.Fitness.(Tezos_protocol_environment_alpha__Environment.T.S.t))
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.context) :=
  Raw_context.prepare level predecessor_timestamp timestamp fitness ctxt.
legacy_script_support_repr.ml 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(* Copyright (c) 2019 Nomadic Labs <contact@nomadic-labs.com>                *)
(* Copyright (c) 2019 Cryptium Labs <contact@cryptium-labs.com>              *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

let manager_script_code : Script_repr.lazy_expr =
  let open Micheline in
  let open Michelson_v1_primitives in
  Script_repr.lazy_expr @@ strip_locations
  @@ Seq
       ( 0,
         [ Prim
             ( 0,
               K_parameter,
               [ Prim
                   ( 0,
                     T_or,
                     [ Prim
                         ( 0,
                           T_lambda,
                           [ Prim (0, T_unit, [], []);
                             Prim
                               (0, T_list, [Prim (0, T_operation, [], [])], [])
                           ],
                           ["%do"] );
                       Prim (0, T_unit, [], ["%default"]) ],
                     [] ) ],
               [] );
           Prim (0, K_storage, [Prim (0, T_key_hash, [], [])], []);
           Prim
             ( 0,
               K_code,
               [ Seq
                   ( 0,
                     [ Seq
                         ( 0,
                           [ Seq
                               ( 0,
                                 [ Prim (0, I_DUP, [], []);
                                   Prim (0, I_CAR, [], []);
                                   Prim
                                     ( 0,
                                       I_DIP,
                                       [Seq (0, [Prim (0, I_CDR, [], [])])],
                                       [] ) ] ) ] );
                       Prim
                         ( 0,
                           I_IF_LEFT,
                           [ Seq
                               ( 0,
                                 [ Prim
                                     ( 0,
                                       I_PUSH,
                                       [ Prim (0, T_mutez, [], []);
                                         Int (0, Z.zero) ],
                                       [] );
                                   Prim (0, I_AMOUNT, [], []);
                                   Seq
                                     ( 0,
                                       [ Seq
                                           ( 0,
                                             [ Prim (0, I_COMPARE, [], []);
                                               Prim (0, I_EQ, [], []) ] );
                                         Prim
                                           ( 0,
                                             I_IF,
                                             [ Seq (0, []);
                                               Seq
                                                 ( 0,
                                                   [ Seq
                                                       ( 0,
                                                         [ Prim
                                                             (0, I_UNIT, [], []);
                                                           Prim
                                                             ( 0,
                                                               I_FAILWITH,
                                                               [],
                                                               [] ) ] ) ] ) ],
                                             [] ) ] );
                                   Seq
                                     ( 0,
                                       [ Prim
                                           ( 0,
                                             I_DIP,
                                             [ Seq
                                                 (0, [Prim (0, I_DUP, [], [])])
                                             ],
                                             [] );
                                         Prim (0, I_SWAP, [], []) ] );
                                   Prim (0, I_IMPLICIT_ACCOUNT, [], []);
                                   Prim (0, I_ADDRESS, [], []);
                                   Prim (0, I_SENDER, [], []);
                                   Seq
                                     ( 0,
                                       [ Seq
                                           ( 0,
                                             [ Prim (0, I_COMPARE, [], []);
                                               Prim (0, I_EQ, [], []) ] );
                                         Prim
                                           ( 0,
                                             I_IF,
                                             [ Seq (0, []);
                                               Seq
                                                 ( 0,
                                                   [ Seq
                                                       ( 0,
                                                         [ Prim
                                                             (0, I_UNIT, [], []);
                                                           Prim
                                                             ( 0,
                                                               I_FAILWITH,
                                                               [],
                                                               [] ) ] ) ] ) ],
                                             [] ) ] );
                                   Prim (0, I_UNIT, [], []);
                                   Prim (0, I_EXEC, [], []);
                                   Prim (0, I_PAIR, [], []) ] );
                             Seq
                               ( 0,
                                 [ Prim (0, I_DROP, [], []);
                                   Prim
                                     ( 0,
                                       I_NIL,
                                       [Prim (0, T_operation, [], [])],
                                       [] );
                                   Prim (0, I_PAIR, [], []) ] ) ],
                           [] ) ] ) ],
               [] ) ] )

(* Find the toplevel expression with a given prim type from list,
   because they can be in arbitrary order. *)
let find_toplevel toplevel exprs =
  let open Micheline in
  let rec iter toplevel = function
    | (Prim (_, prim, _, _) as found) :: _
      when String.equal toplevel (Michelson_v1_primitives.string_of_prim prim)
      ->
        Some found
    | _ :: rest ->
        iter toplevel rest
    | [] ->
        None
  in
  iter (Michelson_v1_primitives.string_of_prim toplevel) exprs

let add_do :
    manager_pkh:Signature.Public_key_hash.t ->
    script_code:Script_repr.lazy_expr ->
    script_storage:Script_repr.lazy_expr ->
    (Script_repr.lazy_expr * Script_repr.lazy_expr) tzresult Lwt.t =
 fun ~manager_pkh ~script_code ~script_storage ->
  let open Micheline in
  let open Michelson_v1_primitives in
  Lwt.return (Script_repr.force_decode script_code)
  >>=? fun (script_code_expr, _gas_cost) ->
  Lwt.return (Script_repr.force_decode script_storage)
  >>|? fun (script_storage_expr, _gas_cost) ->
  let storage_expr = root script_storage_expr in
  match root script_code_expr with
  | Seq (_, toplevel) -> (
    match
      ( find_toplevel K_parameter toplevel,
        find_toplevel K_storage toplevel,
        find_toplevel K_code toplevel )
    with
    | ( Some
          (Prim
            ( _,
              K_parameter,
              [Prim (_, parameter_type, parameter_expr, parameter_annot)],
              prim_param_annot )),
        Some
          (Prim
            ( _,
              K_storage,
              [ Prim
                  (_, code_storage_type, code_storage_expr, code_storage_annot)
              ],
              k_storage_annot )),
        Some (Prim (_, K_code, [code_expr], code_annot)) ) ->
        (* Note that we intentionally don't deal with potential duplicate entrypoints in this migration as there already might be some in contracts that we don't touch. *)
        let migrated_code =
          Seq
            ( 0,
              [ Prim
                  ( 0,
                    K_parameter,
                    [ Prim
                        ( 0,
                          T_or,
                          [ Prim
                              ( 0,
                                T_lambda,
                                [ Prim (0, T_unit, [], []);
                                  Prim
                                    ( 0,
                                      T_list,
                                      [Prim (0, T_operation, [], [])],
                                      [] ) ],
                                ["%do"] );
                            Prim
                              ( 0,
                                parameter_type,
                                parameter_expr,
                                "%default" :: parameter_annot ) ],
                          [] ) ],
                    prim_param_annot );
                Prim
                  ( 0,
                    K_storage,
                    [ Prim
                        ( 0,
                          T_pair,
                          [ Prim (0, T_key_hash, [], []);
                            Prim
                              ( 0,
                                code_storage_type,
                                code_storage_expr,
                                code_storage_annot ) ],
                          [] ) ],
                    k_storage_annot );
                Prim
                  ( 0,
                    K_code,
                    [ Seq
                        ( 0,
                          [ Prim (0, I_DUP, [], []);
                            Prim (0, I_CAR, [], []);
                            Prim
                              ( 0,
                                I_IF_LEFT,
                                [ Seq
                                    ( 0,
                                      [ Prim
                                          ( 0,
                                            I_PUSH,
                                            [ Prim (0, T_mutez, [], []);
                                              Int (0, Z.zero) ],
                                            [] );
                                        Prim (0, I_AMOUNT, [], []);
                                        Seq
                                          ( 0,
                                            [ Seq
                                                ( 0,
                                                  [ Prim (0, I_COMPARE, [], []);
                                                    Prim (0, I_EQ, [], []) ] );
                                              Prim
                                                ( 0,
                                                  I_IF,
                                                  [ Seq (0, []);
                                                    Seq
                                                      ( 0,
                                                        [ Seq
                                                            ( 0,
                                                              [ Prim
                                                                  ( 0,
                                                                    I_UNIT,
                                                                    [],
                                                                    [] );
                                                                Prim
                                                                  ( 0,
                                                                    I_FAILWITH,
                                                                    [],
                                                                    [] ) ] ) ]
                                                      ) ],
                                                  [] ) ] );
                                        Seq
                                          ( 0,
                                            [ Prim
                                                ( 0,
                                                  I_DIP,
                                                  [ Seq
                                                      ( 0,
                                                        [ Prim
                                                            (0, I_DUP, [], [])
                                                        ] ) ],
                                                  [] );
                                              Prim (0, I_SWAP, [], []) ] );
                                        Prim (0, I_CDR, [], []);
                                        Prim (0, I_CAR, [], []);
                                        Prim (0, I_IMPLICIT_ACCOUNT, [], []);
                                        Prim (0, I_ADDRESS, [], []);
                                        Prim (0, I_SENDER, [], []);
                                        Seq
                                          ( 0,
                                            [ Prim (0, I_COMPARE, [], []);
                                              Prim (0, I_NEQ, [], []);
                                              Prim
                                                ( 0,
                                                  I_IF,
                                                  [ Seq
                                                      ( 0,
                                                        [ Prim
                                                            ( 0,
                                                              I_SENDER,
                                                              [],
                                                              [] );
                                                          Prim
                                                            ( 0,
                                                              I_PUSH,
                                                              [ Prim
                                                                  ( 0,
                                                                    T_string,
                                                                    [],
                                                                    [] );
                                                                String
                                                                  ( 0,
                                                                    "Only the \
                                                                     owner \
                                                                     can \
                                                                     operate."
                                                                  ) ],
                                                              [] );
                                                          Prim
                                                            (0, I_PAIR, [], []);
                                                          Prim
                                                            ( 0,
                                                              I_FAILWITH,
                                                              [],
                                                              [] ) ] );
                                                    Seq
                                                      ( 0,
                                                        [ Prim
                                                            (0, I_UNIT, [], []);
                                                          Prim
                                                            (0, I_EXEC, [], []);
                                                          Prim
                                                            ( 0,
                                                              I_DIP,
                                                              [ Seq
                                                                  ( 0,
                                                                    [ Prim
                                                                        ( 0,
                                                                          I_CDR,
                                                                          [],
                                                                          [] )
                                                                    ] ) ],
                                                              [] );
                                                          Prim
                                                            (0, I_PAIR, [], [])
                                                        ] ) ],
                                                  [] ) ] ) ] );
                                  Seq
                                    ( 0,
                                      [ Prim
                                          ( 0,
                                            I_DIP,
                                            [ Seq
                                                ( 0,
                                                  [ Prim (0, I_CDR, [], []);
                                                    Prim (0, I_DUP, [], []);
                                                    Prim (0, I_CDR, [], []) ]
                                                ) ],
                                            [] );
                                        Prim (0, I_PAIR, [], []);
                                        code_expr;
                                        Prim (0, I_SWAP, [], []);
                                        Prim (0, I_CAR, [], []);
                                        Prim (0, I_SWAP, [], []);
                                        Seq
                                          ( 0,
                                            [ Seq
                                                ( 0,
                                                  [ Prim (0, I_DUP, [], []);
                                                    Prim (0, I_CAR, [], []);
                                                    Prim
                                                      ( 0,
                                                        I_DIP,
                                                        [ Seq
                                                            ( 0,
                                                              [ Prim
                                                                  ( 0,
                                                                    I_CDR,
                                                                    [],
                                                                    [] ) ] ) ],
                                                        [] ) ] ) ] );
                                        Prim
                                          ( 0,
                                            I_DIP,
                                            [ Seq
                                                ( 0,
                                                  [ Prim (0, I_SWAP, [], []);
                                                    Prim (0, I_PAIR, [], []) ]
                                                ) ],
                                            [] );
                                        Prim (0, I_PAIR, [], []) ] ) ],
                                [] ) ] ) ],
                    code_annot ) ] )
        in
        let migrated_storage =
          Prim
            ( 0,
              D_Pair,
              [ (* Instead of
                   `String (0, Signature.Public_key_hash.to_b58check manager_pkh)`
                   the storage is written as unparsed with [Optimized] *)
                Bytes
                  ( 0,
                    Data_encoding.Binary.to_bytes_exn
                      Signature.Public_key_hash.encoding
                      manager_pkh );
                storage_expr ],
              [] )
        in
        ( Script_repr.lazy_expr @@ strip_locations migrated_code,
          Script_repr.lazy_expr @@ strip_locations migrated_storage )
    | _ ->
        (script_code, script_storage) )
  | _ ->
      (script_code, script_storage)

let add_set_delegate :
    manager_pkh:Signature.Public_key_hash.t ->
    script_code:Script_repr.lazy_expr ->
    script_storage:Script_repr.lazy_expr ->
    (Script_repr.lazy_expr * Script_repr.lazy_expr) tzresult Lwt.t =
 fun ~manager_pkh ~script_code ~script_storage ->
  let open Micheline in
  let open Michelson_v1_primitives in
  Lwt.return (Script_repr.force_decode script_code)
  >>=? fun (script_code_expr, _gas_cost) ->
  Lwt.return (Script_repr.force_decode script_storage)
  >>|? fun (script_storage_expr, _gas_cost) ->
  let storage_expr = root script_storage_expr in
  match root script_code_expr with
  | Seq (_, toplevel) -> (
    match
      ( find_toplevel K_parameter toplevel,
        find_toplevel K_storage toplevel,
        find_toplevel K_code toplevel )
    with
    | ( Some
          (Prim
            ( _,
              K_parameter,
              [Prim (_, parameter_type, parameter_expr, parameter_annot)],
              prim_param_annot )),
        Some
          (Prim
            ( _,
              K_storage,
              [ Prim
                  (_, code_storage_type, code_storage_expr, code_storage_annot)
              ],
              k_storage_annot )),
        Some (Prim (_, K_code, [code_expr], code_annot)) ) ->
        (* Note that we intentionally don't deal with potential duplicate entrypoints in this migration as there already might be some in contracts that we don't touch. *)
        let migrated_code =
          Seq
            ( 0,
              [ Prim
                  ( 0,
                    K_parameter,
                    [ Prim
                        ( 0,
                          T_or,
                          [ Prim
                              ( 0,
                                T_or,
                                [ Prim (0, T_key_hash, [], ["%set_delegate"]);
                                  Prim (0, T_unit, [], ["%remove_delegate"]) ],
                                [] );
                            Prim
                              ( 0,
                                parameter_type,
                                parameter_expr,
                                "%default" :: parameter_annot ) ],
                          [] ) ],
                    prim_param_annot );
                Prim
                  ( 0,
                    K_storage,
                    [ Prim
                        ( 0,
                          T_pair,
                          [ Prim (0, T_key_hash, [], []);
                            Prim
                              ( 0,
                                code_storage_type,
                                code_storage_expr,
                                code_storage_annot ) ],
                          [] ) ],
                    k_storage_annot );
                Prim
                  ( 0,
                    K_code,
                    [ Seq
                        ( 0,
                          [ Prim (0, I_DUP, [], []);
                            Prim (0, I_CAR, [], []);
                            Prim
                              ( 0,
                                I_IF_LEFT,
                                [ Seq
                                    ( 0,
                                      [ Prim
                                          ( 0,
                                            I_PUSH,
                                            [ Prim (0, T_mutez, [], []);
                                              Int (0, Z.zero) ],
                                            [] );
                                        Prim (0, I_AMOUNT, [], []);
                                        Seq
                                          ( 0,
                                            [ Seq
                                                ( 0,
                                                  [ Prim (0, I_COMPARE, [], []);
                                                    Prim (0, I_EQ, [], []) ] );
                                              Prim
                                                ( 0,
                                                  I_IF,
                                                  [ Seq (0, []);
                                                    Seq
                                                      ( 0,
                                                        [ Seq
                                                            ( 0,
                                                              [ Prim
                                                                  ( 0,
                                                                    I_UNIT,
                                                                    [],
                                                                    [] );
                                                                Prim
                                                                  ( 0,
                                                                    I_FAILWITH,
                                                                    [],
                                                                    [] ) ] ) ]
                                                      ) ],
                                                  [] ) ] );
                                        Seq
                                          ( 0,
                                            [ Prim
                                                ( 0,
                                                  I_DIP,
                                                  [ Seq
                                                      ( 0,
                                                        [ Prim
                                                            (0, I_DUP, [], [])
                                                        ] ) ],
                                                  [] );
                                              Prim (0, I_SWAP, [], []) ] );
                                        Prim (0, I_CDR, [], []);
                                        Prim (0, I_CAR, [], []);
                                        Prim (0, I_IMPLICIT_ACCOUNT, [], []);
                                        Prim (0, I_ADDRESS, [], []);
                                        Prim (0, I_SENDER, [], []);
                                        Seq
                                          ( 0,
                                            [ Prim (0, I_COMPARE, [], []);
                                              Prim (0, I_NEQ, [], []);
                                              Prim
                                                ( 0,
                                                  I_IF,
                                                  [ Seq
                                                      ( 0,
                                                        [ Prim
                                                            ( 0,
                                                              I_SENDER,
                                                              [],
                                                              [] );
                                                          Prim
                                                            ( 0,
                                                              I_PUSH,
                                                              [ Prim
                                                                  ( 0,
                                                                    T_string,
                                                                    [],
                                                                    [] );
                                                                String
                                                                  ( 0,
                                                                    "Only the \
                                                                     owner \
                                                                     can \
                                                                     operate."
                                                                  ) ],
                                                              [] );
                                                          Prim
                                                            (0, I_PAIR, [], []);
                                                          Prim
                                                            ( 0,
                                                              I_FAILWITH,
                                                              [],
                                                              [] ) ] );
                                                    Seq
                                                      ( 0,
                                                        [ Prim
                                                            ( 0,
                                                              I_DIP,
                                                              [ Seq
                                                                  ( 0,
                                                                    [ Prim
                                                                        ( 0,
                                                                          I_CDR,
                                                                          [],
                                                                          [] );
                                                                      Prim
                                                                        ( 0,
                                                                          I_NIL,
                                                                          [ Prim
                                                                              ( 
                                                                              0,
                                                                               T_operation,
                                                                               [],
                                                                               []
                                                                              )
                                                                          ],
                                                                          [] )
                                                                    ] ) ],
                                                              [] );
                                                          Prim
                                                            ( 0,
                                                              I_IF_LEFT,
                                                              [ Seq
                                                                  ( 0,
                                                                    [ Prim
                                                                        ( 0,
                                                                          I_SOME,
                                                                          [],
                                                                          [] );
                                                                      Prim
                                                                        ( 0,
                                                                          I_SET_DELEGATE,
                                                                          [],
                                                                          [] );
                                                                      Prim
                                                                        ( 0,
                                                                          I_CONS,
                                                                          [],
                                                                          [] );
                                                                      Prim
                                                                        ( 0,
                                                                          I_PAIR,
                                                                          [],
                                                                          [] )
                                                                    ] );
                                                                Seq
                                                                  ( 0,
                                                                    [ Prim
                                                                        ( 0,
                                                                          I_DROP,
                                                                          [],
                                                                          [] );
                                                                      Prim
                                                                        ( 0,
                                                                          I_NONE,
                                                                          [ Prim
                                                                              ( 
                                                                              0,
                                                                               T_key_hash,
                                                                               [],
                                                                               []
                                                                              )
                                                                          ],
                                                                          [] );
                                                                      Prim
                                                                        ( 0,
                                                                          I_SET_DELEGATE,
                                                                          [],
                                                                          [] );
                                                                      Prim
                                                                        ( 0,
                                                                          I_CONS,
                                                                          [],
                                                                          [] );
                                                                      Prim
                                                                        ( 0,
                                                                          I_PAIR,
                                                                          [],
                                                                          [] )
                                                                    ] ) ],
                                                              [] ) ] ) ],
                                                  [] ) ] ) ] );
                                  Seq
                                    ( 0,
                                      [ Prim
                                          ( 0,
                                            I_DIP,
                                            [ Seq
                                                ( 0,
                                                  [ Prim (0, I_CDR, [], []);
                                                    Prim (0, I_DUP, [], []);
                                                    Prim (0, I_CDR, [], []) ]
                                                ) ],
                                            [] );
                                        Prim (0, I_PAIR, [], []);
                                        code_expr;
                                        Prim (0, I_SWAP, [], []);
                                        Prim (0, I_CAR, [], []);
                                        Prim (0, I_SWAP, [], []);
                                        Seq
                                          ( 0,
                                            [ Seq
                                                ( 0,
                                                  [ Prim (0, I_DUP, [], []);
                                                    Prim (0, I_CAR, [], []);
                                                    Prim
                                                      ( 0,
                                                        I_DIP,
                                                        [ Seq
                                                            ( 0,
                                                              [ Prim
                                                                  ( 0,
                                                                    I_CDR,
                                                                    [],
                                                                    [] ) ] ) ],
                                                        [] ) ] ) ] );
                                        Prim
                                          ( 0,
                                            I_DIP,
                                            [ Seq
                                                ( 0,
                                                  [ Prim (0, I_SWAP, [], []);
                                                    Prim (0, I_PAIR, [], []) ]
                                                ) ],
                                            [] );
                                        Prim (0, I_PAIR, [], []) ] ) ],
                                [] ) ] ) ],
                    code_annot ) ] )
        in
        let migrated_storage =
          Prim
            ( 0,
              D_Pair,
              [ (* Instead of
                   `String (0, Signature.Public_key_hash.to_b58check manager_pkh)`
                   the storage is written as unparsed with [Optimized] *)
                Bytes
                  ( 0,
                    Data_encoding.Binary.to_bytes_exn
                      Signature.Public_key_hash.encoding
                      manager_pkh );
                storage_expr ],
              [] )
        in
        ( Script_repr.lazy_expr @@ strip_locations migrated_code,
          Script_repr.lazy_expr @@ strip_locations migrated_storage )
    | _ ->
        (script_code, script_storage) )
  | _ ->
      (script_code, script_storage)

let has_default_entrypoint expr =
  let open Micheline in
  let open Michelson_v1_primitives in
  match Script_repr.force_decode expr with
  | Error _ ->
      false
  | Ok (expr, _) -> (
    match root expr with
    | Seq (_, toplevel) -> (
      match find_toplevel K_parameter toplevel with
      | Some (Prim (_, K_parameter, [_], ["%default"])) ->
          false
      | Some (Prim (_, K_parameter, [parameter_expr], _)) ->
          let rec has_default = function
            | Prim (_, T_or, [l; r], annots) ->
                List.exists (String.equal "%default") annots
                || has_default l || has_default r
            | Prim (_, _, _, annots) ->
                List.exists (String.equal "%default") annots
            | _ ->
                false
          in
          has_default parameter_expr
      | Some _ | None ->
          false )
    | _ ->
        false )

let add_root_entrypoint :
    script_code:Script_repr.lazy_expr -> Script_repr.lazy_expr tzresult Lwt.t =
 fun ~script_code ->
  let open Micheline in
  let open Michelson_v1_primitives in
  Lwt.return (Script_repr.force_decode script_code)
  >>|? fun (script_code_expr, _gas_cost) ->
  match root script_code_expr with
  | Seq (_, toplevel) ->
      let migrated_code =
        Seq
          ( 0,
            List.map
              (function
                | Prim (_, K_parameter, [parameter_expr], _) ->
                    Prim (0, K_parameter, [parameter_expr], ["%root"])
                | Prim (_, K_code, exprs, annots) ->
                    let rec rewrite_self = function
                      | ( Int _
                        | String _
                        | Bytes _
                        | Prim (_, I_CREATE_CONTRACT, _, _) ) as leaf ->
                          leaf
                      | Prim (_, I_SELF, [], annots) ->
                          Prim (0, I_SELF, [], "%root" :: annots)
                      | Prim (_, name, args, annots) ->
                          Prim (0, name, List.map rewrite_self args, annots)
                      | Seq (_, args) ->
                          Seq (0, List.map rewrite_self args)
                    in
                    Prim (0, K_code, List.map rewrite_self exprs, annots)
                | other ->
                    other)
              toplevel )
      in
      Script_repr.lazy_expr @@ strip_locations migrated_code
  | _ ->
      script_code
legacy_script_support_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition manager_script_code
  : Tezos_raw_protocol_alpha.Script_repr.lazy_expr :=
  op_atat Script_repr.lazy_expr
    (op_atat strip_locations
      (Tezos_protocol_environment_alpha__Environment.Micheline.Seq 0
        (cons
          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
            Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
            (cons
              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
                Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_or
                (cons
                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                    0 Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_lambda
                    (cons
                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                        0
                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_unit
                        [] [])
                      (cons
                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          0
                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_list
                          (cons
                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                              0
                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_operation
                              [] []) []) []) [])) (cons "%do" % string []))
                  (cons
                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                      0 Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_unit
                      [] (cons "%default" % string [])) [])) []) []) [])
          (cons
            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
              Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_storage
              (cons
                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_key_hash []
                  []) []) [])
            (cons
              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
                Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_code
                (cons
                  (Tezos_protocol_environment_alpha__Environment.Micheline.Seq 0
                    (cons
                      (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                        0
                        (cons
                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                            0
                            (cons
                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                0
                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DUP
                                [] [])
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0
                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CAR
                                  [] [])
                                (cons
                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                    0
                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                    (cons
                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                        0
                                        (cons
                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                            0
                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                            [] []) [])) []) []) [])))) []))
                      (cons
                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          0
                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IF_LEFT
                          (cons
                            (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                              0
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0
                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PUSH
                                  (cons
                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                      0
                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_mutez
                                      [] [])
                                    (cons
                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Int
                                        0 Z.zero) [])) [])
                                (cons
                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                    0
                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_AMOUNT
                                    [] [])
                                  (cons
                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                      0
                                      (cons
                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                          0
                                          (cons
                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                              0
                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_COMPARE
                                              [] [])
                                            (cons
                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                0
                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_EQ
                                                [] []) [])))
                                        (cons
                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                            0
                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IF
                                            (cons
                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                0 [])
                                              (cons
                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                  0
                                                  (cons
                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                      0
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_UNIT
                                                          [] [])
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                            0
                                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_FAILWITH
                                                            [] []) []))) [])) []))
                                            []) [])))
                                    (cons
                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                        0
                                        (cons
                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                            0
                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                            (cons
                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                0
                                                (cons
                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                    0
                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DUP
                                                    [] []) [])) []) [])
                                          (cons
                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                              0
                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SWAP
                                              [] []) [])))
                                      (cons
                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                          0
                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IMPLICIT_ACCOUNT
                                          [] [])
                                        (cons
                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                            0
                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_ADDRESS
                                            [] [])
                                          (cons
                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                              0
                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SENDER
                                              [] [])
                                            (cons
                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                0
                                                (cons
                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                    0
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_COMPARE
                                                        [] [])
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_EQ
                                                          [] []) [])))
                                                  (cons
                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                      0
                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IF
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                          0 [])
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                            0
                                                            (cons
                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                0
                                                                (cons
                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                    0
                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_UNIT
                                                                    [] [])
                                                                  (cons
                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                      0
                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_FAILWITH
                                                                      [] []) [])))
                                                              [])) [])) []) [])))
                                              (cons
                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                  0
                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_UNIT
                                                  [] [])
                                                (cons
                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                    0
                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_EXEC
                                                    [] [])
                                                  (cons
                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                      0
                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                      [] []) []))))))))))))
                            (cons
                              (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                0
                                (cons
                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                    0
                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DROP
                                    [] [])
                                  (cons
                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                      0
                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_NIL
                                      (cons
                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                          0
                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_operation
                                          [] []) []) [])
                                    (cons
                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                        0
                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                        [] []) [])))) [])) []) []))) []) []) []))))).

Definition find_toplevel {A : Type}
  (toplevel : Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim)
  (exprs :
    list
      (Tezos_protocol_environment_alpha__Environment.Micheline.node A
        Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim))
  : option
    (Tezos_protocol_environment_alpha__Environment.Micheline.node A
      Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) :=
  let fix iter {B : Type}
    (toplevel : Tezos_protocol_environment_alpha__Environment.String.t)
    (function_parameter :
    list
      (Tezos_protocol_environment_alpha__Environment.Micheline.node B
        Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim))
    : option
      (Tezos_protocol_environment_alpha__Environment.Micheline.node B
        Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) :=
    match function_parameter with
    |
      cons
        ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim _ prim _
          _) as found) _ => Some found
    | cons _ rest => iter toplevel rest
    | [] => None
    end in
  iter (Michelson_v1_primitives.string_of_prim toplevel) exprs.

Definition add_do
  (manager_pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (script_code : Tezos_raw_protocol_alpha.Script_repr.lazy_expr)
  (script_storage : Tezos_raw_protocol_alpha.Script_repr.lazy_expr)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Script_repr.lazy_expr *
        Tezos_raw_protocol_alpha.Script_repr.lazy_expr)) :=
  op_gtgteqquestion (Lwt.__return (Script_repr.force_decode script_code))
    (fun function_parameter =>
      let '(script_code_expr, _gas_cost) := function_parameter in
      op_gtgtpipequestion
        (Lwt.__return (Script_repr.force_decode script_storage))
        (fun function_parameter =>
          let '(script_storage_expr, _gas_cost) := function_parameter in
          let storage_expr := root script_storage_expr in
          match root script_code_expr with
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Seq _
              toplevel =>
            match
              ((find_toplevel
                Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
                toplevel),
                (find_toplevel
                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_storage
                  toplevel),
                (find_toplevel
                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_code
                  toplevel)) with
            |
              (Some
                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim _
                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
                  (cons
                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                      _ parameter_type parameter_expr parameter_annot) [])
                  prim_param_annot),
                Some
                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                    _ Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_storage
                    (cons
                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                        _ code_storage_type code_storage_expr code_storage_annot)
                      []) k_storage_annot),
                Some
                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                    _ Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_code
                    (cons code_expr []) code_annot)) =>
              let migrated_code :=
                Tezos_protocol_environment_alpha__Environment.Micheline.Seq 0
                  (cons
                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                      0
                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
                      (cons
                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          0
                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_or
                          (cons
                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                              0
                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_lambda
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0
                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_unit
                                  [] [])
                                (cons
                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                    0
                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_list
                                    (cons
                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                        0
                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_operation
                                        [] []) []) []) []))
                              (cons "%do" % string []))
                            (cons
                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                0 parameter_type parameter_expr
                                (cons "%default" % string parameter_annot)) []))
                          []) []) prim_param_annot)
                    (cons
                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                        0
                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_storage
                        (cons
                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                            0
                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_pair
                            (cons
                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                0
                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_key_hash
                                [] [])
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0 code_storage_type code_storage_expr
                                  code_storage_annot) [])) []) [])
                        k_storage_annot)
                      (cons
                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          0
                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_code
                          (cons
                            (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                              0
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0
                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DUP
                                  [] [])
                                (cons
                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                    0
                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CAR
                                    [] [])
                                  (cons
                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                      0
                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IF_LEFT
                                      (cons
                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                          0
                                          (cons
                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                              0
                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PUSH
                                              (cons
                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                  0
                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_mutez
                                                  [] [])
                                                (cons
                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Int
                                                    0 Z.zero) [])) [])
                                            (cons
                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                0
                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_AMOUNT
                                                [] [])
                                              (cons
                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                  0
                                                  (cons
                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                      0
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_COMPARE
                                                          [] [])
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                            0
                                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_EQ
                                                            [] []) [])))
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IF
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                            0 [])
                                                          (cons
                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                              0
                                                              (cons
                                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                  0
                                                                  (cons
                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                      0
                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_UNIT
                                                                      [] [])
                                                                    (cons
                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                        0
                                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_FAILWITH
                                                                        [] [])
                                                                      []))) []))
                                                            [])) []) [])))
                                                (cons
                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                    0
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                            0
                                                            (cons
                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                0
                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DUP
                                                                [] []) [])) [])
                                                        [])
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SWAP
                                                          [] []) [])))
                                                  (cons
                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                      0
                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                                      [] [])
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CAR
                                                        [] [])
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IMPLICIT_ACCOUNT
                                                          [] [])
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                            0
                                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_ADDRESS
                                                            [] [])
                                                          (cons
                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                              0
                                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SENDER
                                                              [] [])
                                                            (cons
                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                0
                                                                (cons
                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                    0
                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_COMPARE
                                                                    [] [])
                                                                  (cons
                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                      0
                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_NEQ
                                                                      [] [])
                                                                    (cons
                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                        0
                                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IF
                                                                        (cons
                                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                            0
                                                                            (cons
                                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                0
                                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SENDER
                                                                                []
                                                                                [])
                                                                              (cons
                                                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                  0
                                                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PUSH
                                                                                  (cons
                                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                      0
                                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_string
                                                                                      []
                                                                                      [])
                                                                                    (cons
                                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.String
                                                                                        0
                                                                                        "Only the owner can operate."
                                                                                          %
                                                                                          string)
                                                                                      []))
                                                                                  [])
                                                                                (cons
                                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                    0
                                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                                                    []
                                                                                    [])
                                                                                  (cons
                                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                      0
                                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_FAILWITH
                                                                                      []
                                                                                      [])
                                                                                    [])))))
                                                                          (cons
                                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                              0
                                                                              (cons
                                                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                  0
                                                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_UNIT
                                                                                  []
                                                                                  [])
                                                                                (cons
                                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                    0
                                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_EXEC
                                                                                    []
                                                                                    [])
                                                                                  (cons
                                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                      0
                                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                                                                      (cons
                                                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                                          0
                                                                                          (cons
                                                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                              0
                                                                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                                                                              []
                                                                                              [])
                                                                                            []))
                                                                                        [])
                                                                                      [])
                                                                                    (cons
                                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                        0
                                                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                                                        []
                                                                                        [])
                                                                                      [])))))
                                                                            []))
                                                                        []) []))))
                                                              [])))))))))))
                                        (cons
                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                            0
                                            (cons
                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                0
                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                                (cons
                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                    0
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                                        [] [])
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DUP
                                                          [] [])
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                            0
                                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                                            [] []) [])))) []) [])
                                              (cons
                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                  0
                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                  [] [])
                                                (cons code_expr
                                                  (cons
                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                      0
                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SWAP
                                                      [] [])
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CAR
                                                        [] [])
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SWAP
                                                          [] [])
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                            0
                                                            (cons
                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                0
                                                                (cons
                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                    0
                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DUP
                                                                    [] [])
                                                                  (cons
                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                      0
                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CAR
                                                                      [] [])
                                                                    (cons
                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                        0
                                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                                                        (cons
                                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                            0
                                                                            (cons
                                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                0
                                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                                                                []
                                                                                [])
                                                                              []))
                                                                          []) [])
                                                                      [])))) []))
                                                          (cons
                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                              0
                                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                                              (cons
                                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                  0
                                                                  (cons
                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                      0
                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SWAP
                                                                      [] [])
                                                                    (cons
                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                        0
                                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                                        [] [])
                                                                      []))) [])
                                                              [])
                                                            (cons
                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                0
                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                                [] []) []))))))))))
                                          [])) []) [])))) []) code_annot) [])))
                in
              let migrated_storage :=
                Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.D_Pair
                  (cons
                    (Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                      0
                      (Data_encoding.Binary.to_bytes_exn
                        Signature.Public_key_hash.encoding manager_pkh))
                    (cons storage_expr [])) [] in
              ((op_atat Script_repr.lazy_expr (strip_locations migrated_code)),
                (op_atat Script_repr.lazy_expr
                  (strip_locations migrated_storage)))
            | _ => (script_code, script_storage)
            end
          | _ => (script_code, script_storage)
          end)).

Definition add_set_delegate
  (manager_pkh :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (script_code : Tezos_raw_protocol_alpha.Script_repr.lazy_expr)
  (script_storage : Tezos_raw_protocol_alpha.Script_repr.lazy_expr)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Script_repr.lazy_expr *
        Tezos_raw_protocol_alpha.Script_repr.lazy_expr)) :=
  op_gtgteqquestion (Lwt.__return (Script_repr.force_decode script_code))
    (fun function_parameter =>
      let '(script_code_expr, _gas_cost) := function_parameter in
      op_gtgtpipequestion
        (Lwt.__return (Script_repr.force_decode script_storage))
        (fun function_parameter =>
          let '(script_storage_expr, _gas_cost) := function_parameter in
          let storage_expr := root script_storage_expr in
          match root script_code_expr with
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Seq _
              toplevel =>
            match
              ((find_toplevel
                Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
                toplevel),
                (find_toplevel
                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_storage
                  toplevel),
                (find_toplevel
                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_code
                  toplevel)) with
            |
              (Some
                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim _
                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
                  (cons
                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                      _ parameter_type parameter_expr parameter_annot) [])
                  prim_param_annot),
                Some
                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                    _ Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_storage
                    (cons
                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                        _ code_storage_type code_storage_expr code_storage_annot)
                      []) k_storage_annot),
                Some
                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                    _ Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_code
                    (cons code_expr []) code_annot)) =>
              let migrated_code :=
                Tezos_protocol_environment_alpha__Environment.Micheline.Seq 0
                  (cons
                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                      0
                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
                      (cons
                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          0
                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_or
                          (cons
                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                              0
                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_or
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0
                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_key_hash
                                  [] (cons "%set_delegate" % string []))
                                (cons
                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                    0
                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_unit
                                    [] (cons "%remove_delegate" % string [])) []))
                              [])
                            (cons
                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                0 parameter_type parameter_expr
                                (cons "%default" % string parameter_annot)) []))
                          []) []) prim_param_annot)
                    (cons
                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                        0
                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_storage
                        (cons
                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                            0
                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_pair
                            (cons
                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                0
                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_key_hash
                                [] [])
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0 code_storage_type code_storage_expr
                                  code_storage_annot) [])) []) [])
                        k_storage_annot)
                      (cons
                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          0
                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_code
                          (cons
                            (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                              0
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0
                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DUP
                                  [] [])
                                (cons
                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                    0
                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CAR
                                    [] [])
                                  (cons
                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                      0
                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IF_LEFT
                                      (cons
                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                          0
                                          (cons
                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                              0
                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PUSH
                                              (cons
                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                  0
                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_mutez
                                                  [] [])
                                                (cons
                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Int
                                                    0 Z.zero) [])) [])
                                            (cons
                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                0
                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_AMOUNT
                                                [] [])
                                              (cons
                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                  0
                                                  (cons
                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                      0
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_COMPARE
                                                          [] [])
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                            0
                                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_EQ
                                                            [] []) [])))
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IF
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                            0 [])
                                                          (cons
                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                              0
                                                              (cons
                                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                  0
                                                                  (cons
                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                      0
                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_UNIT
                                                                      [] [])
                                                                    (cons
                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                        0
                                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_FAILWITH
                                                                        [] [])
                                                                      []))) []))
                                                            [])) []) [])))
                                                (cons
                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                    0
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                            0
                                                            (cons
                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                0
                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DUP
                                                                [] []) [])) [])
                                                        [])
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SWAP
                                                          [] []) [])))
                                                  (cons
                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                      0
                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                                      [] [])
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CAR
                                                        [] [])
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IMPLICIT_ACCOUNT
                                                          [] [])
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                            0
                                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_ADDRESS
                                                            [] [])
                                                          (cons
                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                              0
                                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SENDER
                                                              [] [])
                                                            (cons
                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                0
                                                                (cons
                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                    0
                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_COMPARE
                                                                    [] [])
                                                                  (cons
                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                      0
                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_NEQ
                                                                      [] [])
                                                                    (cons
                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                        0
                                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IF
                                                                        (cons
                                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                            0
                                                                            (cons
                                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                0
                                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SENDER
                                                                                []
                                                                                [])
                                                                              (cons
                                                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                  0
                                                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PUSH
                                                                                  (cons
                                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                      0
                                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_string
                                                                                      []
                                                                                      [])
                                                                                    (cons
                                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.String
                                                                                        0
                                                                                        "Only the owner can operate."
                                                                                          %
                                                                                          string)
                                                                                      []))
                                                                                  [])
                                                                                (cons
                                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                    0
                                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                                                    []
                                                                                    [])
                                                                                  (cons
                                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                      0
                                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_FAILWITH
                                                                                      []
                                                                                      [])
                                                                                    [])))))
                                                                          (cons
                                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                              0
                                                                              (cons
                                                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                  0
                                                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                                                                  (cons
                                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                                      0
                                                                                      (cons
                                                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                          0
                                                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                                                                          []
                                                                                          [])
                                                                                        (cons
                                                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                            0
                                                                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_NIL
                                                                                            (cons
                                                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                                0
                                                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_operation
                                                                                                []
                                                                                                [])
                                                                                              [])
                                                                                            [])
                                                                                          [])))
                                                                                    [])
                                                                                  [])
                                                                                (cons
                                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                    0
                                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_IF_LEFT
                                                                                    (cons
                                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                                        0
                                                                                        (cons
                                                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                            0
                                                                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SOME
                                                                                            []
                                                                                            [])
                                                                                          (cons
                                                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                              0
                                                                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SET_DELEGATE
                                                                                              []
                                                                                              [])
                                                                                            (cons
                                                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                                0
                                                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CONS
                                                                                                []
                                                                                                [])
                                                                                              (cons
                                                                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                                  0
                                                                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                                                                  []
                                                                                                  [])
                                                                                                [])))))
                                                                                      (cons
                                                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                                          0
                                                                                          (cons
                                                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                              0
                                                                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DROP
                                                                                              []
                                                                                              [])
                                                                                            (cons
                                                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                                0
                                                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_NONE
                                                                                                (cons
                                                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                                    0
                                                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_key_hash
                                                                                                    []
                                                                                                    [])
                                                                                                  [])
                                                                                                [])
                                                                                              (cons
                                                                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                                  0
                                                                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SET_DELEGATE
                                                                                                  []
                                                                                                  [])
                                                                                                (cons
                                                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                                    0
                                                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CONS
                                                                                                    []
                                                                                                    [])
                                                                                                  (cons
                                                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                                      0
                                                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                                                                      []
                                                                                                      [])
                                                                                                    []))))))
                                                                                        []))
                                                                                    [])
                                                                                  [])))
                                                                            []))
                                                                        []) []))))
                                                              [])))))))))))
                                        (cons
                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                            0
                                            (cons
                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                0
                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                                (cons
                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                    0
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                                        [] [])
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DUP
                                                          [] [])
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                            0
                                                            Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                                            [] []) [])))) []) [])
                                              (cons
                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                  0
                                                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                  [] [])
                                                (cons code_expr
                                                  (cons
                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                      0
                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SWAP
                                                      [] [])
                                                    (cons
                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                        0
                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CAR
                                                        [] [])
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                          0
                                                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SWAP
                                                          [] [])
                                                        (cons
                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                            0
                                                            (cons
                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                0
                                                                (cons
                                                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                    0
                                                                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DUP
                                                                    [] [])
                                                                  (cons
                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                      0
                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CAR
                                                                      [] [])
                                                                    (cons
                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                        0
                                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                                                        (cons
                                                                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                            0
                                                                            (cons
                                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                                0
                                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CDR
                                                                                []
                                                                                [])
                                                                              []))
                                                                          []) [])
                                                                      [])))) []))
                                                          (cons
                                                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                              0
                                                              Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_DIP
                                                              (cons
                                                                (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                                                                  0
                                                                  (cons
                                                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                      0
                                                                      Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SWAP
                                                                      [] [])
                                                                    (cons
                                                                      (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                        0
                                                                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                                        [] [])
                                                                      []))) [])
                                                              [])
                                                            (cons
                                                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                                                0
                                                                Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_PAIR
                                                                [] []) []))))))))))
                                          [])) []) [])))) []) code_annot) [])))
                in
              let migrated_storage :=
                Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
                  Tezos_raw_protocol_alpha.Michelson_v1_primitives.D_Pair
                  (cons
                    (Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                      0
                      (Data_encoding.Binary.to_bytes_exn
                        Signature.Public_key_hash.encoding manager_pkh))
                    (cons storage_expr [])) [] in
              ((op_atat Script_repr.lazy_expr (strip_locations migrated_code)),
                (op_atat Script_repr.lazy_expr
                  (strip_locations migrated_storage)))
            | _ => (script_code, script_storage)
            end
          | _ => (script_code, script_storage)
          end)).

Definition has_default_entrypoint
  (expr : Tezos_raw_protocol_alpha.Script_repr.lazy_expr) : bool :=
  match Script_repr.force_decode expr with
  | Tezos_protocol_environment_alpha__Environment.Pervasives.Error _ => false
  | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok (expr, _) =>
    match root expr with
    | Tezos_protocol_environment_alpha__Environment.Micheline.Seq _ toplevel =>
      match
        find_toplevel
          Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter toplevel
        with
      |
        Some
          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim _
            Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
            (cons _ []) (cons "%default" % string [])) => false
      |
        Some
          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim _
            Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
            (cons parameter_expr []) _) =>
        let fix has_default {A : Type}
          (function_parameter :
          Tezos_protocol_environment_alpha__Environment.Micheline.node A
            Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) : bool :=
          match function_parameter with
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim _
              Tezos_raw_protocol_alpha.Michelson_v1_primitives.T_or
              (cons l (cons r [])) annots =>
            op_pipepipe
              (List.__exists (String.equal "%default" % string) annots)
              (op_pipepipe (has_default l) (has_default r))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim _ _ _
              annots => List.__exists (String.equal "%default" % string) annots
          | _ => false
          end in
        has_default parameter_expr
      | Some _ | None => false
      end
    | _ => false
    end
  end.

Definition add_root_entrypoint
  (script_code : Tezos_raw_protocol_alpha.Script_repr.lazy_expr)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Script_repr.lazy_expr) :=
  op_gtgtpipequestion (Lwt.__return (Script_repr.force_decode script_code))
    (fun function_parameter =>
      let '(script_code_expr, _gas_cost) := function_parameter in
      match root script_code_expr with
      | Tezos_protocol_environment_alpha__Environment.Micheline.Seq _ toplevel
        =>
        let migrated_code :=
          Tezos_protocol_environment_alpha__Environment.Micheline.Seq 0
            (List.map
              (fun function_parameter =>
                match function_parameter with
                |
                  Tezos_protocol_environment_alpha__Environment.Micheline.Prim _
                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
                    (cons parameter_expr []) _ =>
                  Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_parameter
                    (cons parameter_expr []) (cons "%root" % string [])
                |
                  Tezos_protocol_environment_alpha__Environment.Micheline.Prim _
                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_code
                    exprs annots =>
                  let fix rewrite_self
                    (function_parameter :
                    Tezos_protocol_environment_alpha__Environment.Micheline.node
                      Z Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim)
                    : Tezos_protocol_environment_alpha__Environment.Micheline.node
                      Z Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim :=
                    match function_parameter with
                    |
                      (Tezos_protocol_environment_alpha__Environment.Micheline.Int
                        _ _ |
                        Tezos_protocol_environment_alpha__Environment.Micheline.String
                          _ _ |
                        Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                          _ _ |
                        Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          _
                          Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_CREATE_CONTRACT
                          _ _) as leaf => leaf
                    |
                      Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                        _
                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SELF
                        [] annots =>
                      Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                        0
                        Tezos_raw_protocol_alpha.Michelson_v1_primitives.I_SELF
                        [] (cons "%root" % string annots)
                    |
                      Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                        _ name args annots =>
                      Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                        0 name (List.map rewrite_self args) annots
                    |
                      Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                        _ args =>
                      Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                        0 (List.map rewrite_self args)
                    end in
                  Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
                    Tezos_raw_protocol_alpha.Michelson_v1_primitives.K_code
                    (List.map rewrite_self exprs) annots
                | other => other
                end) toplevel) in
        op_atat Script_repr.lazy_expr (strip_locations migrated_code)
      | _ => script_code
      end).
legacy_script_support_repr.mli 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(* Copyright (c) 2019 Nomadic Labs <contact@nomadic-labs.com>                *)
(* Copyright (c) 2019 Cryptium Labs <contact@cryptium-labs.com>              *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** This code mimics the now defunct scriptless KT1s.

    The manager contract is from:
    https://gitlab.com/nomadic-labs/mi-cho-coq/blob/7b42f2e970e1541af54f8a9b6820b4f18e847575/src/contracts/manager.tz
    The formal proof is at:
    https://gitlab.com/nomadic-labs/mi-cho-coq/blob/a7603e12021166e15890f6d504feebec2f945502/src/contracts_coq/manager.v *)
val manager_script_code : Script_repr.lazy_expr

(** This code mimics the now defunct "spendable" flags of KT1s by
    adding a [do] entrypoint, preserving the original script's at
    'default' entrypoint.

    The pseudo-code for the applied transformations is from:
    https://gitlab.com/nomadic-labs/mi-cho-coq/blob/7b42f2e970e1541af54f8a9b6820b4f18e847575/src/contracts/transform/add_do.tz *)
val add_do :
  manager_pkh:Signature.Public_key_hash.t ->
  script_code:Script_repr.lazy_expr ->
  script_storage:Script_repr.lazy_expr ->
  (Script_repr.lazy_expr * Script_repr.lazy_expr) tzresult Lwt.t

(** This code mimics the now defunct "spendable" flags of KT1s by
    adding a [do] entrypoint, preserving the original script's at
    'default' entrypoint.

    The pseudo-code for the applied transformations is from:
    https://gitlab.com/nomadic-labs/mi-cho-coq/blob/7b42f2e970e1541af54f8a9b6820b4f18e847575/src/contracts/transform/add_set_delegate.tz *)
val add_set_delegate :
  manager_pkh:Signature.Public_key_hash.t ->
  script_code:Script_repr.lazy_expr ->
  script_storage:Script_repr.lazy_expr ->
  (Script_repr.lazy_expr * Script_repr.lazy_expr) tzresult Lwt.t

(** Checks if a contract was declaring a default entrypoint somewhere
   else than at the root, in which case its type changes when
   entrypoints are activated. *)
val has_default_entrypoint : Script_repr.lazy_expr -> bool

(** Adds a [%root] annotation on the toplevel parameter construct. *)
val add_root_entrypoint :
  script_code:Script_repr.lazy_expr -> Script_repr.lazy_expr tzresult Lwt.t
legacy_script_support_repr_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter manager_script_code : Tezos_raw_protocol_alpha.Script_repr.lazy_expr.

Parameter add_do :
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Script_repr.lazy_expr ->
    Tezos_raw_protocol_alpha.Script_repr.lazy_expr ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Script_repr.lazy_expr *
            Tezos_raw_protocol_alpha.Script_repr.lazy_expr)).

Parameter add_set_delegate :
Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Script_repr.lazy_expr ->
    Tezos_raw_protocol_alpha.Script_repr.lazy_expr ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Script_repr.lazy_expr *
            Tezos_raw_protocol_alpha.Script_repr.lazy_expr)).

Parameter has_default_entrypoint :
Tezos_raw_protocol_alpha.Script_repr.lazy_expr -> bool.

Parameter add_root_entrypoint :
Tezos_raw_protocol_alpha.Script_repr.lazy_expr ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Script_repr.lazy_expr).
level_repr.ml 4 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = {
  level : Raw_level_repr.t;
  level_position : int32;
  cycle : Cycle_repr.t;
  cycle_position : int32;
  voting_period : Voting_period_repr.t;
  voting_period_position : int32;
  expected_commitment : bool;
}

include Compare.Make (struct
  type nonrec t = t

  let compare {level = l1} {level = l2} = Raw_level_repr.compare l1 l2
end)

type level = t

let pp ppf {level} = Raw_level_repr.pp ppf level

let pp_full ppf l =
  Format.fprintf
    ppf
    "%a.%ld (cycle %a.%ld) (vote %a.%ld)"
    Raw_level_repr.pp
    l.level
    l.level_position
    Cycle_repr.pp
    l.cycle
    l.cycle_position
    Voting_period_repr.pp
    l.voting_period
    l.voting_period_position

let encoding =
  let open Data_encoding in
  conv
    (fun { level;
           level_position;
           cycle;
           cycle_position;
           voting_period;
           voting_period_position;
           expected_commitment } ->
      ( level,
        level_position,
        cycle,
        cycle_position,
        voting_period,
        voting_period_position,
        expected_commitment ))
    (fun ( level,
           level_position,
           cycle,
           cycle_position,
           voting_period,
           voting_period_position,
           expected_commitment ) ->
      {
        level;
        level_position;
        cycle;
        cycle_position;
        voting_period;
        voting_period_position;
        expected_commitment;
      })
    (obj7
       (req
          "level"
          ~description:
            "The level of the block relative to genesis. This is also the \
             Shell's notion of level"
          Raw_level_repr.encoding)
       (req
          "level_position"
          ~description:
            "The level of the block relative to the block that starts \
             protocol alpha. This is specific to the protocol alpha. Other \
             protocols might or might not include a similar notion."
          int32)
       (req
          "cycle"
          ~description:
            "The current cycle's number. Note that cycles are a \
             protocol-specific notion. As a result, the cycle number starts \
             at 0 with the first block of protocol alpha."
          Cycle_repr.encoding)
       (req
          "cycle_position"
          ~description:
            "The current level of the block relative to the first block of \
             the current cycle."
          int32)
       (req
          "voting_period"
          ~description:
            "The current voting period's index. Note that cycles are a \
             protocol-specific notion. As a result, the voting period index \
             starts at 0 with the first block of protocol alpha."
          Voting_period_repr.encoding)
       (req
          "voting_period_position"
          ~description:
            "The current level of the block relative to the first block of \
             the current voting period."
          int32)
       (req
          "expected_commitment"
          ~description:
            "Tells wether the baker of this block has to commit a seed nonce \
             hash."
          bool))

let root first_level =
  {
    level = first_level;
    level_position = 0l;
    cycle = Cycle_repr.root;
    cycle_position = 0l;
    voting_period = Voting_period_repr.root;
    voting_period_position = 0l;
    expected_commitment = false;
  }

let from_raw ~first_level ~blocks_per_cycle ~blocks_per_voting_period
    ~blocks_per_commitment level =
  let raw_level = Raw_level_repr.to_int32 level in
  let first_level = Raw_level_repr.to_int32 first_level in
  let level_position =
    Compare.Int32.max 0l (Int32.sub raw_level first_level)
  in
  let cycle =
    Cycle_repr.of_int32_exn (Int32.div level_position blocks_per_cycle)
  in
  let cycle_position = Int32.rem level_position blocks_per_cycle in
  let voting_period =
    Voting_period_repr.of_int32_exn
      (Int32.div level_position blocks_per_voting_period)
  in
  let voting_period_position =
    Int32.rem level_position blocks_per_voting_period
  in
  let expected_commitment =
    Compare.Int32.(
      Int32.rem cycle_position blocks_per_commitment
      = Int32.pred blocks_per_commitment)
  in
  {
    level;
    level_position;
    cycle;
    cycle_position;
    voting_period;
    voting_period_position;
    expected_commitment;
  }

let diff {level = l1; _} {level = l2; _} =
  Int32.sub (Raw_level_repr.to_int32 l1) (Raw_level_repr.to_int32 l2)
level_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Record t := {
  level : Tezos_raw_protocol_alpha.Raw_level_repr.t;
  level_position : int32;
  cycle : Tezos_raw_protocol_alpha.Cycle_repr.t;
  cycle_position : int32;
  voting_period : Tezos_raw_protocol_alpha.Voting_period_repr.t;
  voting_period_position : int32;
  expected_commitment : bool }.

(* ❌ Cannot include this kind of module expression *)
include

Definition level := t.

Definition pp
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (function_parameter : t) : unit :=
  let '{| level := level |} := function_parameter in
  Raw_level_repr.pp ppf level.

Definition pp_full
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter) (l : t)
  : unit :=
  Format.fprintf ppf
    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
          "." % char
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
              " (cycle " % string
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                  "." % char
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      ") (vote " % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          "." % char
                          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                              ")" % char
                              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))))))))))))
      "%a.%ld (cycle %a.%ld) (vote %a.%ld)" % string) Raw_level_repr.pp
    (level l) (level_position l) Cycle_repr.pp (cycle l) (cycle_position l)
    Voting_period_repr.pp (voting_period l) (voting_period_position l).

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
  conv
    (fun function_parameter =>
      let '{|
        level := level;
          level_position := level_position;
          cycle := cycle;
          cycle_position := cycle_position;
          voting_period := voting_period;
          voting_period_position := voting_period_position;
          expected_commitment := expected_commitment
          |} := function_parameter in
      (level, level_position, cycle, cycle_position, voting_period,
        voting_period_position, expected_commitment))
    (fun function_parameter =>
      let
        '(level, level_position, cycle, cycle_position, voting_period,
          voting_period_position, expected_commitment) := function_parameter in
      {| level := level; level_position := level_position; cycle := cycle;
        cycle_position := cycle_position; voting_period := voting_period;
        voting_period_position := voting_period_position;
        expected_commitment := expected_commitment |}) None
    (obj7
      (req None
        (Some
          "The level of the block relative to genesis. This is also the Shell's notion of level"
            % string) "level" % string Raw_level_repr.encoding)
      (req None
        (Some
          "The level of the block relative to the block that starts protocol alpha. This is specific to the protocol alpha. Other protocols might or might not include a similar notion."
            % string) "level_position" % string int32)
      (req None
        (Some
          "The current cycle's number. Note that cycles are a protocol-specific notion. As a result, the cycle number starts at 0 with the first block of protocol alpha."
            % string) "cycle" % string Cycle_repr.encoding)
      (req None
        (Some
          "The current level of the block relative to the first block of the current cycle."
            % string) "cycle_position" % string int32)
      (req None
        (Some
          "The current voting period's index. Note that cycles are a protocol-specific notion. As a result, the voting period index starts at 0 with the first block of protocol alpha."
            % string) "voting_period" % string Voting_period_repr.encoding)
      (req None
        (Some
          "The current level of the block relative to the first block of the current voting period."
            % string) "voting_period_position" % string int32)
      (req None
        (Some
          "Tells wether the baker of this block has to commit a seed nonce hash."
            % string) "expected_commitment" % string bool)).

Definition root (first_level : Tezos_raw_protocol_alpha.Raw_level_repr.t) : t :=
  {| level := first_level;
    level_position :=
      (* ❌ Constant of type int32 is converted to int *)
      0; cycle := Cycle_repr.root;
    cycle_position :=
      (* ❌ Constant of type int32 is converted to int *)
      0; voting_period := Voting_period_repr.root;
    voting_period_position :=
      (* ❌ Constant of type int32 is converted to int *)
      0; expected_commitment := false |}.

Definition from_raw
  (first_level : Tezos_raw_protocol_alpha.Raw_level_repr.raw_level)
  (blocks_per_cycle : int32) (blocks_per_voting_period : int32)
  (blocks_per_commitment : int32)
  (level : Tezos_raw_protocol_alpha.Raw_level_repr.raw_level) : t :=
  let raw_level := Raw_level_repr.to_int32 level in
  let first_level := Raw_level_repr.to_int32 first_level in
  let level_position :=
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.max)
      (* ❌ Constant of type int32 is converted to int *)
      0 (Int32.sub raw_level first_level) in
  let cycle :=
    Cycle_repr.of_int32_exn (Int32.div level_position blocks_per_cycle) in
  let cycle_position := Int32.rem level_position blocks_per_cycle in
  let voting_period :=
    Voting_period_repr.of_int32_exn
      (Int32.div level_position blocks_per_voting_period) in
  let voting_period_position :=
    Int32.rem level_position blocks_per_voting_period in
  let expected_commitment :=
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
      (Int32.rem cycle_position blocks_per_commitment)
      (Int32.pred blocks_per_commitment) in
  {| level := level; level_position := level_position; cycle := cycle;
    cycle_position := cycle_position; voting_period := voting_period;
    voting_period_position := voting_period_position;
    expected_commitment := expected_commitment |}.

Definition diff (function_parameter : t) : t -> int32 :=
  let '{| level := l1 |} := function_parameter in
  fun function_parameter =>
    let '{| level := l2 |} := function_parameter in
    Int32.sub (Raw_level_repr.to_int32 l1) (Raw_level_repr.to_int32 l2).
level_repr.mli 2 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = private {
  level : Raw_level_repr.t;
      (** The level of the block relative to genesis. This
                              is also the Shell's notion of level. *)
  level_position : int32;
      (** The level of the block relative to the block that
                            starts protocol alpha. This is specific to the
                            protocol alpha. Other protocols might or might not
                            include a similar notion. *)
  cycle : Cycle_repr.t;
      (** The current cycle's number. Note that cycles are a
                          protocol-specific notion. As a result, the cycle
                          number starts at 0 with the first block of protocol
                          alpha. *)
  cycle_position : int32;
      (** The current level of the block relative to the first
                            block of the current cycle. *)
  voting_period : Voting_period_repr.t;
  voting_period_position : int32;
  expected_commitment : bool;
}

(* Note that, the type `t` above must respect some invariants (hence the
   `private` annotation). Notably:

   level_position = cycle * blocks_per_cycle + cycle_position
*)

type level = t

include Compare.S with type t := level

val encoding : level Data_encoding.t

val pp : Format.formatter -> level -> unit

val pp_full : Format.formatter -> level -> unit

val root : Raw_level_repr.t -> level

val from_raw :
  first_level:Raw_level_repr.t ->
  blocks_per_cycle:int32 ->
  blocks_per_voting_period:int32 ->
  blocks_per_commitment:int32 ->
  Raw_level_repr.t ->
  level

val diff : level -> level -> int32
level_repr_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Record t := {
  level : Tezos_raw_protocol_alpha.Raw_level_repr.t;
  level_position : int32;
  cycle : Tezos_raw_protocol_alpha.Cycle_repr.t;
  cycle_position : int32;
  voting_period : Tezos_raw_protocol_alpha.Voting_period_repr.t;
  voting_period_position : int32;
  expected_commitment : bool }.

Definition level := t.

include

Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t level.

Parameter pp :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> level -> unit.

Parameter pp_full :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> level -> unit.

Parameter root : Tezos_raw_protocol_alpha.Raw_level_repr.t -> level.

Parameter from_raw :
Tezos_raw_protocol_alpha.Raw_level_repr.t ->
  int32 -> int32 -> int32 -> Tezos_raw_protocol_alpha.Raw_level_repr.t -> level.

Parameter diff : level -> level -> int32.
level_storage.ml 4 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Level_repr

let from_raw c ?offset l =
  let l =
    match offset with
    | None ->
        l
    | Some o ->
        Raw_level_repr.(of_int32_exn (Int32.add (to_int32 l) o))
  in
  let constants = Raw_context.constants c in
  let first_level = Raw_context.first_level c in
  Level_repr.from_raw
    ~first_level
    ~blocks_per_cycle:constants.Constants_repr.blocks_per_cycle
    ~blocks_per_voting_period:constants.Constants_repr.blocks_per_voting_period
    ~blocks_per_commitment:constants.Constants_repr.blocks_per_commitment
    l

let root c = Level_repr.root (Raw_context.first_level c)

let succ c l = from_raw c (Raw_level_repr.succ l.level)

let pred c l =
  match Raw_level_repr.pred l.Level_repr.level with
  | None ->
      None
  | Some l ->
      Some (from_raw c l)

let current ctxt = Raw_context.current_level ctxt

let previous ctxt =
  let l = current ctxt in
  match pred ctxt l with
  | None ->
      assert false (* We never validate the Genesis... *)
  | Some p ->
      p

let first_level_in_cycle ctxt c =
  let constants = Raw_context.constants ctxt in
  let first_level = Raw_context.first_level ctxt in
  from_raw
    ctxt
    (Raw_level_repr.of_int32_exn
       (Int32.add
          (Raw_level_repr.to_int32 first_level)
          (Int32.mul
             constants.Constants_repr.blocks_per_cycle
             (Cycle_repr.to_int32 c))))

let last_level_in_cycle ctxt c =
  match pred ctxt (first_level_in_cycle ctxt (Cycle_repr.succ c)) with
  | None ->
      assert false
  | Some x ->
      x

let levels_in_cycle ctxt cycle =
  let first = first_level_in_cycle ctxt cycle in
  let rec loop n acc =
    if Cycle_repr.(n.cycle = first.cycle) then loop (succ ctxt n) (n :: acc)
    else acc
  in
  loop first []

let levels_in_current_cycle ctxt ?(offset = 0l) () =
  let current_cycle = Cycle_repr.to_int32 (current ctxt).cycle in
  let cycle = Int32.add current_cycle offset in
  if Compare.Int32.(cycle < 0l) then []
  else
    let cycle = Cycle_repr.of_int32_exn cycle in
    levels_in_cycle ctxt cycle

let levels_with_commitments_in_cycle ctxt c =
  let first = first_level_in_cycle ctxt c in
  let rec loop n acc =
    if Cycle_repr.(n.cycle = first.cycle) then
      if n.expected_commitment then loop (succ ctxt n) (n :: acc)
      else loop (succ ctxt n) acc
    else acc
  in
  loop first []

let last_allowed_fork_level c =
  let level = Raw_context.current_level c in
  let preserved_cycles = Constants_storage.preserved_cycles c in
  match Cycle_repr.sub level.cycle preserved_cycles with
  | None ->
      Raw_level_repr.root
  | Some cycle ->
      (first_level_in_cycle c cycle).level
level_storage_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Level_repr.

Definition from_raw
  (c : Tezos_raw_protocol_alpha.Raw_context.context) (offset : option int32)
  (l : Tezos_raw_protocol_alpha.Raw_level_repr.raw_level)
  : Tezos_raw_protocol_alpha.Level_repr.level :=
  let l :=
    match offset with
    | None => l
    | Some o => of_int32_exn (Int32.add (to_int32 l) o)
    end in
  let constants := Raw_context.constants c in
  let first_level := Raw_context.first_level c in
  Level_repr.from_raw first_level (Constants_repr.blocks_per_cycle constants)
    (Constants_repr.blocks_per_voting_period constants)
    (Constants_repr.blocks_per_commitment constants) l.

Definition root (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Level_repr.level :=
  Level_repr.root (Raw_context.first_level c).

Definition succ
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  (l : Tezos_raw_protocol_alpha.Level_repr.t)
  : Tezos_raw_protocol_alpha.Level_repr.level :=
  from_raw c None (Raw_level_repr.succ (level l)).

Definition pred
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  (l : Tezos_raw_protocol_alpha.Level_repr.t)
  : option Tezos_raw_protocol_alpha.Level_repr.level :=
  match Raw_level_repr.pred (Level_repr.level l) with
  | None => None
  | Some l => Some (from_raw c None l)
  end.

Definition current (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Level_repr.t := Raw_context.current_level ctxt.

Definition previous (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Level_repr.level :=
  let l := current ctxt in
  match pred ctxt l with
  | None =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | Some p => p
  end.

Definition first_level_in_cycle
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (c : Tezos_raw_protocol_alpha.Cycle_repr.cycle)
  : Tezos_raw_protocol_alpha.Level_repr.level :=
  let constants := Raw_context.constants ctxt in
  let first_level := Raw_context.first_level ctxt in
  from_raw ctxt None
    (Raw_level_repr.of_int32_exn
      (Int32.add (Raw_level_repr.to_int32 first_level)
        (Int32.mul (Constants_repr.blocks_per_cycle constants)
          (Cycle_repr.to_int32 c)))).

Definition last_level_in_cycle
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (c : Tezos_raw_protocol_alpha.Cycle_repr.cycle)
  : Tezos_raw_protocol_alpha.Level_repr.level :=
  match pred ctxt (first_level_in_cycle ctxt (Cycle_repr.succ c)) with
  | None =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | Some x => x
  end.

Definition levels_in_cycle
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (cycle : Tezos_raw_protocol_alpha.Cycle_repr.cycle)
  : list Tezos_raw_protocol_alpha.Level_repr.t :=
  let first := first_level_in_cycle ctxt cycle in
  let fix loop
    (n : Tezos_raw_protocol_alpha.Level_repr.t) (acc :
    list Tezos_raw_protocol_alpha.Level_repr.t)
    : list Tezos_raw_protocol_alpha.Level_repr.t :=
    if op_eq (cycle n) (cycle first) then
      loop (succ ctxt n) (cons n acc)
    else
      acc in
  loop first [].

Definition levels_in_current_cycle
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (op_staroptstar : option int32)
  : unit -> list Tezos_raw_protocol_alpha.Level_repr.t :=
  let offset :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None =>
      (* ❌ Constant of type int32 is converted to int *)
      0
    end in
  fun function_parameter =>
    let 'tt := function_parameter in
    let current_cycle := Cycle_repr.to_int32 (cycle (current ctxt)) in
    let cycle := Int32.add current_cycle offset in
    if
      Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
        cycle
        (* ❌ Constant of type int32 is converted to int *)
        0 then
      []
    else
      let cycle := Cycle_repr.of_int32_exn cycle in
      levels_in_cycle ctxt cycle.

Definition levels_with_commitments_in_cycle
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (c : Tezos_raw_protocol_alpha.Cycle_repr.cycle)
  : list Tezos_raw_protocol_alpha.Level_repr.t :=
  let first := first_level_in_cycle ctxt c in
  let fix loop
    (n : Tezos_raw_protocol_alpha.Level_repr.t) (acc :
    list Tezos_raw_protocol_alpha.Level_repr.t)
    : list Tezos_raw_protocol_alpha.Level_repr.t :=
    if op_eq (cycle n) (cycle first) then
      if expected_commitment n then
        loop (succ ctxt n) (cons n acc)
      else
        loop (succ ctxt n) acc
    else
      acc in
  loop first [].

Definition last_allowed_fork_level
  (c : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_raw_protocol_alpha.Raw_level_repr.raw_level :=
  let level := Raw_context.current_level c in
  let preserved_cycles := Constants_storage.preserved_cycles c in
  match Cycle_repr.sub (cycle level) preserved_cycles with
  | None => Raw_level_repr.root
  | Some cycle => level (first_level_in_cycle c cycle)
  end.
level_storage.mli 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

val current : Raw_context.t -> Level_repr.t

val previous : Raw_context.t -> Level_repr.t

val root : Raw_context.t -> Level_repr.t

val from_raw :
  Raw_context.t -> ?offset:int32 -> Raw_level_repr.t -> Level_repr.t

val pred : Raw_context.t -> Level_repr.t -> Level_repr.t option

val succ : Raw_context.t -> Level_repr.t -> Level_repr.t

val first_level_in_cycle : Raw_context.t -> Cycle_repr.t -> Level_repr.t

val last_level_in_cycle : Raw_context.t -> Cycle_repr.t -> Level_repr.t

val levels_in_cycle : Raw_context.t -> Cycle_repr.t -> Level_repr.t list

val levels_in_current_cycle :
  Raw_context.t -> ?offset:int32 -> unit -> Level_repr.t list

val levels_with_commitments_in_cycle :
  Raw_context.t -> Cycle_repr.t -> Level_repr.t list

val last_allowed_fork_level : Raw_context.t -> Raw_level_repr.t
level_storage_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter current :
Tezos_raw_protocol_alpha.Raw_context.t -> Tezos_raw_protocol_alpha.Level_repr.t.

Parameter previous :
Tezos_raw_protocol_alpha.Raw_context.t -> Tezos_raw_protocol_alpha.Level_repr.t.

Parameter root :
Tezos_raw_protocol_alpha.Raw_context.t -> Tezos_raw_protocol_alpha.Level_repr.t.

Parameter from_raw :
Tezos_raw_protocol_alpha.Raw_context.t ->
  option int32 ->
    Tezos_raw_protocol_alpha.Raw_level_repr.t ->
      Tezos_raw_protocol_alpha.Level_repr.t.

Parameter pred :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Level_repr.t ->
    option Tezos_raw_protocol_alpha.Level_repr.t.

Parameter succ :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Level_repr.t -> Tezos_raw_protocol_alpha.Level_repr.t.

Parameter first_level_in_cycle :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t -> Tezos_raw_protocol_alpha.Level_repr.t.

Parameter last_level_in_cycle :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t -> Tezos_raw_protocol_alpha.Level_repr.t.

Parameter levels_in_cycle :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t ->
    list Tezos_raw_protocol_alpha.Level_repr.t.

Parameter levels_in_current_cycle :
Tezos_raw_protocol_alpha.Raw_context.t ->
  option int32 -> unit -> list Tezos_raw_protocol_alpha.Level_repr.t.

Parameter levels_with_commitments_in_cycle :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t ->
    list Tezos_raw_protocol_alpha.Level_repr.t.

Parameter last_allowed_fork_level :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Raw_level_repr.t.
main.ml 17 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* Tezos Protocol Implementation - Protocol Signature Instance *)

type block_header_data = Alpha_context.Block_header.protocol_data

type block_header = Alpha_context.Block_header.t = {
  shell : Block_header.shell_header;
  protocol_data : block_header_data;
}

let block_header_data_encoding =
  Alpha_context.Block_header.protocol_data_encoding

type block_header_metadata = Apply_results.block_metadata

let block_header_metadata_encoding = Apply_results.block_metadata_encoding

type operation_data = Alpha_context.packed_protocol_data =
  | Operation_data :
      'kind Alpha_context.Operation.protocol_data
      -> operation_data

let operation_data_encoding = Alpha_context.Operation.protocol_data_encoding

type operation_receipt = Apply_results.packed_operation_metadata =
  | Operation_metadata :
      'kind Apply_results.operation_metadata
      -> operation_receipt
  | No_operation_metadata : operation_receipt

let operation_receipt_encoding = Apply_results.operation_metadata_encoding

let operation_data_and_receipt_encoding =
  Apply_results.operation_data_and_metadata_encoding

type operation = Alpha_context.packed_operation = {
  shell : Operation.shell_header;
  protocol_data : operation_data;
}

let acceptable_passes = Alpha_context.Operation.acceptable_passes

let max_block_length = Alpha_context.Block_header.max_header_length

let max_operation_data_length =
  Alpha_context.Constants.max_operation_data_length

let validation_passes =
  let max_anonymous_operations =
    Alpha_context.Constants.max_revelations_per_block
    + (* allow 100 wallet activations or denunciations per block *) 100
  in
  Updater.
    [ {max_size = 32 * 1024; max_op = Some 32};
      (* 32 endorsements *)
      {max_size = 32 * 1024; max_op = None};
      (* 32k of voting operations *)
      {
        max_size = max_anonymous_operations * 1024;
        max_op = Some max_anonymous_operations;
      };
      {max_size = 512 * 1024; max_op = None} ]

(* 512kB *)

let rpc_services =
  Alpha_services.register () ;
  Services_registration.get_rpc_services ()

type validation_mode =
  | Application of {
      block_header : Alpha_context.Block_header.t;
      baker : Alpha_context.public_key_hash;
      block_delay : Alpha_context.Period.t;
    }
  | Partial_application of {
      block_header : Alpha_context.Block_header.t;
      baker : Alpha_context.public_key_hash;
      block_delay : Alpha_context.Period.t;
    }
  | Partial_construction of {predecessor : Block_hash.t}
  | Full_construction of {
      predecessor : Block_hash.t;
      protocol_data : Alpha_context.Block_header.contents;
      baker : Alpha_context.public_key_hash;
      block_delay : Alpha_context.Period.t;
    }

type validation_state = {
  mode : validation_mode;
  chain_id : Chain_id.t;
  ctxt : Alpha_context.t;
  op_count : int;
}

let current_context {ctxt; _} = return (Alpha_context.finalize ctxt).context

let begin_partial_application ~chain_id ~ancestor_context:ctxt
    ~predecessor_timestamp ~predecessor_fitness
    (block_header : Alpha_context.Block_header.t) =
  let level = block_header.shell.level in
  let fitness = predecessor_fitness in
  let timestamp = block_header.shell.timestamp in
  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt
  >>=? fun ctxt ->
  Apply.begin_application ctxt chain_id block_header predecessor_timestamp
  >>=? fun (ctxt, baker, block_delay) ->
  let mode =
    Partial_application
      {block_header; baker = Signature.Public_key.hash baker; block_delay}
  in
  return {mode; chain_id; ctxt; op_count = 0}

let begin_application ~chain_id ~predecessor_context:ctxt
    ~predecessor_timestamp ~predecessor_fitness
    (block_header : Alpha_context.Block_header.t) =
  let level = block_header.shell.level in
  let fitness = predecessor_fitness in
  let timestamp = block_header.shell.timestamp in
  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt
  >>=? fun ctxt ->
  Apply.begin_application ctxt chain_id block_header predecessor_timestamp
  >>=? fun (ctxt, baker, block_delay) ->
  let mode =
    Application
      {block_header; baker = Signature.Public_key.hash baker; block_delay}
  in
  return {mode; chain_id; ctxt; op_count = 0}

let begin_construction ~chain_id ~predecessor_context:ctxt
    ~predecessor_timestamp ~predecessor_level:pred_level
    ~predecessor_fitness:pred_fitness ~predecessor ~timestamp
    ?(protocol_data : block_header_data option) () =
  let level = Int32.succ pred_level in
  let fitness = pred_fitness in
  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt
  >>=? fun ctxt ->
  ( match protocol_data with
  | None ->
      Apply.begin_partial_construction ctxt
      >>=? fun ctxt ->
      let mode = Partial_construction {predecessor} in
      return (mode, ctxt)
  | Some proto_header ->
      Apply.begin_full_construction
        ctxt
        predecessor_timestamp
        proto_header.contents
      >>=? fun (ctxt, protocol_data, baker, block_delay) ->
      let mode =
        let baker = Signature.Public_key.hash baker in
        Full_construction {predecessor; baker; protocol_data; block_delay}
      in
      return (mode, ctxt) )
  >>=? fun (mode, ctxt) -> return {mode; chain_id; ctxt; op_count = 0}

let apply_operation ({mode; chain_id; ctxt; op_count; _} as data)
    (operation : Alpha_context.packed_operation) =
  match mode with
  | Partial_application _
    when not
           (List.exists
              (Compare.Int.equal 0)
              (Alpha_context.Operation.acceptable_passes operation)) ->
      (* Multipass validation only considers operations in pass 0. *)
      let op_count = op_count + 1 in
      return ({data with ctxt; op_count}, No_operation_metadata)
  | _ ->
      let {shell; protocol_data = Operation_data protocol_data} = operation in
      let operation : _ Alpha_context.operation = {shell; protocol_data} in
      let (predecessor, baker) =
        match mode with
        | Partial_application
            {block_header = {shell = {predecessor; _}; _}; baker}
        | Application {block_header = {shell = {predecessor; _}; _}; baker}
        | Full_construction {predecessor; baker; _} ->
            (predecessor, baker)
        | Partial_construction {predecessor} ->
            (predecessor, Signature.Public_key_hash.zero)
      in
      Apply.apply_operation
        ctxt
        chain_id
        Optimized
        predecessor
        baker
        (Alpha_context.Operation.hash operation)
        operation
      >>=? fun (ctxt, result) ->
      let op_count = op_count + 1 in
      return ({data with ctxt; op_count}, Operation_metadata result)

let finalize_block {mode; ctxt; op_count} =
  match mode with
  | Partial_construction _ ->
      let level = Alpha_context.Level.current ctxt in
      Alpha_context.Vote.get_current_period_kind ctxt
      >>=? fun voting_period_kind ->
      let baker = Signature.Public_key_hash.zero in
      Signature.Public_key_hash.Map.fold
        (fun delegate deposit ctxt ->
          ctxt
          >>=? fun ctxt ->
          Alpha_context.Delegate.freeze_deposit ctxt delegate deposit)
        (Alpha_context.get_deposits ctxt)
        (return ctxt)
      >>=? fun ctxt ->
      let ctxt = Alpha_context.finalize ctxt in
      return
        ( ctxt,
          Apply_results.
            {
              baker;
              level;
              voting_period_kind;
              nonce_hash = None;
              consumed_gas = Z.zero;
              deactivated = [];
              balance_updates = [];
            } )
  | Partial_application {block_header; baker; block_delay} ->
      let level = Alpha_context.Level.current ctxt in
      let included_endorsements = Alpha_context.included_endorsements ctxt in
      Apply.check_minimum_endorsements
        ctxt
        block_header.protocol_data.contents
        block_delay
        included_endorsements
      >>=? fun () ->
      Alpha_context.Vote.get_current_period_kind ctxt
      >>=? fun voting_period_kind ->
      let ctxt = Alpha_context.finalize ctxt in
      return
        ( ctxt,
          Apply_results.
            {
              baker;
              level;
              voting_period_kind;
              nonce_hash = None;
              consumed_gas = Z.zero;
              deactivated = [];
              balance_updates = [];
            } )
  | Application
      { baker;
        block_delay;
        block_header = {protocol_data = {contents = protocol_data; _}; _} }
  | Full_construction {protocol_data; baker; block_delay; _} ->
      Apply.finalize_application ctxt protocol_data baker ~block_delay
      >>=? fun (ctxt, receipt) ->
      let level = Alpha_context.Level.current ctxt in
      let priority = protocol_data.priority in
      let raw_level = Alpha_context.Raw_level.to_int32 level.level in
      let fitness = Alpha_context.Fitness.current ctxt in
      let commit_message =
        Format.asprintf
          "lvl %ld, fit 1:%Ld, prio %d, %d ops"
          raw_level
          fitness
          priority
          op_count
      in
      let ctxt = Alpha_context.finalize ~commit_message ctxt in
      return (ctxt, receipt)

let compare_operations op1 op2 =
  let open Alpha_context in
  let (Operation_data op1) = op1.protocol_data in
  let (Operation_data op2) = op2.protocol_data in
  match (op1.contents, op2.contents) with
  | (Single (Endorsement _), Single (Endorsement _)) ->
      0
  | (_, Single (Endorsement _)) ->
      1
  | (Single (Endorsement _), _) ->
      -1
  | (Single (Seed_nonce_revelation _), Single (Seed_nonce_revelation _)) ->
      0
  | (_, Single (Seed_nonce_revelation _)) ->
      1
  | (Single (Seed_nonce_revelation _), _) ->
      -1
  | ( Single (Double_endorsement_evidence _),
      Single (Double_endorsement_evidence _) ) ->
      0
  | (_, Single (Double_endorsement_evidence _)) ->
      1
  | (Single (Double_endorsement_evidence _), _) ->
      -1
  | (Single (Double_baking_evidence _), Single (Double_baking_evidence _)) ->
      0
  | (_, Single (Double_baking_evidence _)) ->
      1
  | (Single (Double_baking_evidence _), _) ->
      -1
  | (Single (Activate_account _), Single (Activate_account _)) ->
      0
  | (_, Single (Activate_account _)) ->
      1
  | (Single (Activate_account _), _) ->
      -1
  | (Single (Proposals _), Single (Proposals _)) ->
      0
  | (_, Single (Proposals _)) ->
      1
  | (Single (Proposals _), _) ->
      -1
  | (Single (Ballot _), Single (Ballot _)) ->
      0
  | (_, Single (Ballot _)) ->
      1
  | (Single (Ballot _), _) ->
      -1
  (* Manager operations with smaller counter are pre-validated first. *)
  | (Single (Manager_operation op1), Single (Manager_operation op2)) ->
      Z.compare op1.counter op2.counter
  | (Cons (Manager_operation op1, _), Single (Manager_operation op2)) ->
      Z.compare op1.counter op2.counter
  | (Single (Manager_operation op1), Cons (Manager_operation op2, _)) ->
      Z.compare op1.counter op2.counter
  | (Cons (Manager_operation op1, _), Cons (Manager_operation op2, _)) ->
      Z.compare op1.counter op2.counter

let init ctxt block_header =
  let level = block_header.Block_header.level in
  let fitness = block_header.fitness in
  let timestamp = block_header.timestamp in
  let typecheck (ctxt : Alpha_context.context)
      (script : Alpha_context.Script.t) =
    Script_ir_translator.parse_script ctxt ~legacy:false script
    >>=? fun (Ex_script parsed_script, ctxt) ->
    Script_ir_translator.extract_big_map_diff
      ctxt
      Optimized
      parsed_script.storage_type
      parsed_script.storage
      ~to_duplicate:Script_ir_translator.no_big_map_id
      ~to_update:Script_ir_translator.no_big_map_id
      ~temporary:false
    >>=? fun (storage, big_map_diff, ctxt) ->
    Script_ir_translator.unparse_data
      ctxt
      Optimized
      parsed_script.storage_type
      storage
    >>=? fun (storage, ctxt) ->
    let storage =
      Alpha_context.Script.lazy_expr (Micheline.strip_locations storage)
    in
    return (({script with storage}, big_map_diff), ctxt)
  in
  Alpha_context.prepare_first_block ~typecheck ~level ~timestamp ~fitness ctxt
  >>=? fun ctxt -> return (Alpha_context.finalize ctxt)

(* Vanity nonce: 313282890 *)
main_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition block_header_data :=
  Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data.

Record block_header := {
  shell :
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header;
  protocol_data : block_header_data }.

Definition block_header_data_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    Tezos_raw_protocol_alpha.Alpha_context.Block_header.protocol_data :=
  Alpha_context.Block_header.protocol_data_encoding.

Definition block_header_metadata :=
  Tezos_raw_protocol_alpha.Apply_results.block_metadata.

Definition block_header_metadata_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    Tezos_raw_protocol_alpha.Apply_results.block_metadata :=
  Apply_results.block_metadata_encoding.

Reserved Notation "'operation_data".

Inductive operation_data_gadt : Type :=
| Operation_data : forall {kind : Type},
  Tezos_raw_protocol_alpha.Alpha_context.Operation.protocol_data kind ->
  operation_data_gadt

where "'operation_data" := (operation_data_gadt).

Definition operation_data := 'operation_data.

Definition operation_data_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    Tezos_raw_protocol_alpha.Alpha_context.Operation.packed_protocol_data :=
  Alpha_context.Operation.protocol_data_encoding.

Reserved Notation "'operation_receipt".

Inductive operation_receipt_gadt : Type :=
| Operation_metadata : forall {kind : Type},
  Tezos_raw_protocol_alpha.Apply_results.operation_metadata kind ->
  operation_receipt_gadt
| No_operation_metadata : operation_receipt_gadt

where "'operation_receipt" := (operation_receipt_gadt).

Definition operation_receipt := 'operation_receipt.

Definition operation_receipt_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    Tezos_raw_protocol_alpha.Apply_results.packed_operation_metadata :=
  Apply_results.operation_metadata_encoding.

Definition operation_data_and_receipt_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    (Tezos_raw_protocol_alpha.Alpha_context.Operation.packed_protocol_data *
      Tezos_raw_protocol_alpha.Apply_results.packed_operation_metadata) :=
  Apply_results.operation_data_and_metadata_encoding.

Record operation := {
  shell : Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
  protocol_data : operation_data }.

Definition acceptable_passes
  : Tezos_raw_protocol_alpha__Alpha_context.packed_operation -> list Z :=
  Alpha_context.Operation.acceptable_passes.

Definition max_block_length : Z := Alpha_context.Block_header.max_header_length.

Definition max_operation_data_length : Z :=
  Alpha_context.Constants.max_operation_data_length.

Definition validation_passes
  : list Tezos_protocol_environment_alpha__Environment.Updater.quota :=
  let max_anonymous_operations :=
    op_plus Alpha_context.Constants.max_revelations_per_block 100 in
  cons {| max_size := op_star 32 1024; max_op := Some 32 |}
    (cons {| max_size := op_star 32 1024; max_op := None |}
      (cons
        {| max_size := op_star max_anonymous_operations 1024;
          max_op := Some max_anonymous_operations |}
        (cons {| max_size := op_star 512 1024; max_op := None |} []))).

Definition rpc_services
  : Tezos_protocol_environment_alpha__Environment.RPC_directory.directory
    Tezos_protocol_environment_alpha__Environment.Updater.rpc_context :=
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Alpha_services.register tt in
  Services_registration.get_rpc_services tt.

Inductive validation_mode : Type :=
| Application : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t ->
  Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
  Tezos_raw_protocol_alpha.Alpha_context.Period.t -> validation_mode
| Partial_application : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t ->
  Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
  Tezos_raw_protocol_alpha.Alpha_context.Period.t -> validation_mode
| Partial_construction :
  Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
  -> validation_mode
| Full_construction :
  Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
  -> Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents ->
  Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
  Tezos_raw_protocol_alpha.Alpha_context.Period.t -> validation_mode.

Record validation_state := {
  mode : validation_mode;
  chain_id :
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t);
  ctxt : Tezos_raw_protocol_alpha.Alpha_context.t;
  op_count : Z }.

Definition current_context (function_parameter : validation_state)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Context.t) :=
  let '{| ctxt := ctxt |} := function_parameter in
  __return (context (Alpha_context.finalize None ctxt)).

Definition begin_partial_application
  (chain_id :
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  (predecessor_timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (predecessor_fitness : Tezos_raw_protocol_alpha.Alpha_context.Fitness.t)
  (block_header : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      validation_state) :=
  let level := level (shell block_header) in
  let fitness := predecessor_fitness in
  let timestamp := timestamp (shell block_header) in
  op_gtgteqquestion
    (Alpha_context.prepare ctxt level predecessor_timestamp timestamp fitness)
    (fun ctxt =>
      op_gtgteqquestion
        (Apply.begin_application ctxt chain_id block_header
          predecessor_timestamp)
        (fun function_parameter =>
          let '(ctxt, baker, block_delay) := function_parameter in
          let mode :=
            Partial_application
              {| block_header := block_header;
                baker := Signature.Public_key.hash baker;
                block_delay := block_delay |} in
          __return
            {| mode := mode; chain_id := chain_id; ctxt := ctxt; op_count := 0
              |})).

Definition begin_application
  (chain_id :
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  (predecessor_timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (predecessor_fitness : Tezos_raw_protocol_alpha.Alpha_context.Fitness.t)
  (block_header : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      validation_state) :=
  let level := level (shell block_header) in
  let fitness := predecessor_fitness in
  let timestamp := timestamp (shell block_header) in
  op_gtgteqquestion
    (Alpha_context.prepare ctxt level predecessor_timestamp timestamp fitness)
    (fun ctxt =>
      op_gtgteqquestion
        (Apply.begin_application ctxt chain_id block_header
          predecessor_timestamp)
        (fun function_parameter =>
          let '(ctxt, baker, block_delay) := function_parameter in
          let mode :=
            Application
              {| block_header := block_header;
                baker := Signature.Public_key.hash baker;
                block_delay := block_delay |} in
          __return
            {| mode := mode; chain_id := chain_id; ctxt := ctxt; op_count := 0
              |})).

Definition begin_construction
  (chain_id :
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  (predecessor_timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (pred_level : int32)
  (pred_fitness : Tezos_raw_protocol_alpha.Alpha_context.Fitness.t)
  (predecessor :
    Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (protocol_data : option block_header_data) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      validation_state) :=
  let 'tt := function_parameter in
  let level := Int32.succ pred_level in
  let fitness := pred_fitness in
  op_gtgteqquestion
    (Alpha_context.prepare ctxt level predecessor_timestamp timestamp fitness)
    (fun ctxt =>
      op_gtgteqquestion
        match protocol_data with
        | None =>
          op_gtgteqquestion (Apply.begin_partial_construction ctxt)
            (fun ctxt =>
              let mode := Partial_construction {| predecessor := predecessor |}
                in
              __return (mode, ctxt))
        | Some proto_header =>
          op_gtgteqquestion
            (Apply.begin_full_construction ctxt predecessor_timestamp
              (contents proto_header))
            (fun function_parameter =>
              let '(ctxt, protocol_data, baker, block_delay) :=
                function_parameter in
              let mode :=
                let baker := Signature.Public_key.hash baker in
                Full_construction
                  {| predecessor := predecessor; protocol_data := protocol_data;
                    baker := baker; block_delay := block_delay |} in
              __return (mode, ctxt))
        end
        (fun function_parameter =>
          let '(mode, ctxt) := function_parameter in
          __return
            {| mode := mode; chain_id := chain_id; ctxt := ctxt; op_count := 0
              |})).

Definition apply_operation (function_parameter : validation_state)
  : Tezos_raw_protocol_alpha.Alpha_context.packed_operation ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (validation_state * operation_receipt)) :=
  let
    '{|
      mode := mode;
        chain_id := chain_id;
        ctxt := ctxt;
        op_count := op_count
        |} as data := function_parameter in
  fun operation =>
    match mode with
    | Partial_application _ =>
      let op_count := op_plus op_count 1 in
      __return
        ((* ❌ Record substitution not handled *)
        record_substitution, No_operation_metadata)
    | _ =>
      let '{|
        shell := shell; protocol_data := Operation_data protocol_data |} :=
        operation in
      let operation := {| shell := shell; protocol_data := protocol_data |} in
      let '(predecessor, baker) :=
        match mode with
        |
          Partial_application {|
            block_header := {| shell := {| predecessor := predecessor |} |};
              baker := baker
              |} |
            Application {|
              block_header := {| shell := {| predecessor := predecessor |} |};
                baker := baker
                |} |
            Full_construction {| predecessor := predecessor; baker := baker |}
          => (predecessor, baker)
        | Partial_construction {| predecessor := predecessor |} =>
          (predecessor, Signature.Public_key_hash.zero)
        end in
      op_gtgteqquestion
        (Apply.apply_operation ctxt chain_id
          Tezos_raw_protocol_alpha.Script_ir_translator.Optimized predecessor
          baker (Alpha_context.Operation.hash operation) operation)
        (fun function_parameter =>
          let '(ctxt, result) := function_parameter in
          let op_count := op_plus op_count 1 in
          __return
            ((* ❌ Record substitution not handled *)
            record_substitution, (Operation_metadata result)))
    end.

Definition finalize_block (function_parameter : validation_state)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.Updater.validation_result *
        Tezos_raw_protocol_alpha.Apply_results.block_metadata)) :=
  let '{| mode := mode; ctxt := ctxt; op_count := op_count |} :=
    function_parameter in
  match mode with
  | Partial_construction _ =>
    let level := Alpha_context.Level.current ctxt in
    op_gtgteqquestion (Alpha_context.Vote.get_current_period_kind ctxt)
      (fun voting_period_kind =>
        let baker := Signature.Public_key_hash.zero in
        op_gtgteqquestion
          (Signature.Public_key_hash.Map.fold
            (fun delegate =>
              fun deposit =>
                fun ctxt =>
                  op_gtgteqquestion ctxt
                    (fun ctxt =>
                      Alpha_context.Delegate.freeze_deposit ctxt delegate
                        deposit)) (Alpha_context.get_deposits ctxt)
            (__return ctxt))
          (fun ctxt =>
            let ctxt := Alpha_context.finalize None ctxt in
            __return
              (ctxt,
                {| baker := baker; level := level;
                  voting_period_kind := voting_period_kind; nonce_hash := None;
                  consumed_gas := Z.zero; deactivated := [];
                  balance_updates := [] |})))
  |
    Partial_application {|
      block_header := block_header;
        baker := baker;
        block_delay := block_delay
        |} =>
    let level := Alpha_context.Level.current ctxt in
    let included_endorsements := Alpha_context.included_endorsements ctxt in
    op_gtgteqquestion
      (Apply.check_minimum_endorsements ctxt
        (contents (protocol_data block_header)) block_delay
        included_endorsements)
      (fun function_parameter =>
        let 'tt := function_parameter in
        op_gtgteqquestion (Alpha_context.Vote.get_current_period_kind ctxt)
          (fun voting_period_kind =>
            let ctxt := Alpha_context.finalize None ctxt in
            __return
              (ctxt,
                {| baker := baker; level := level;
                  voting_period_kind := voting_period_kind; nonce_hash := None;
                  consumed_gas := Z.zero; deactivated := [];
                  balance_updates := [] |})))
  |
    Application {|
      block_header := {| protocol_data := {| contents := protocol_data |} |};
        baker := baker;
        block_delay := block_delay
        |} |
      Full_construction {|
        protocol_data := protocol_data;
          baker := baker;
          block_delay := block_delay
          |} =>
    op_gtgteqquestion
      (Apply.finalize_application ctxt protocol_data baker block_delay)
      (fun function_parameter =>
        let '(ctxt, receipt) := function_parameter in
        let level := Alpha_context.Level.current ctxt in
        let priority := priority protocol_data in
        let raw_level := Alpha_context.Raw_level.to_int32 (level level) in
        let fitness := Alpha_context.Fitness.current ctxt in
        let commit_message :=
          Format.asprintf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "lvl " % string
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    ", fit 1:" % string
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int64
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                        ", prio " % string
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                            ", " % string
                            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int
                              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                                " ops" % string
                                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))))))
              "lvl %ld, fit 1:%Ld, prio %d, %d ops" % string) raw_level fitness
            priority op_count in
        let ctxt := Alpha_context.finalize (Some commit_message) ctxt in
        __return (ctxt, receipt))
  end.

Definition compare_operations
  (op1 : Tezos_raw_protocol_alpha.Alpha_context.packed_operation)
  (op2 : Tezos_raw_protocol_alpha.Alpha_context.packed_operation) : Z :=
  let 'Tezos_raw_protocol_alpha.Alpha_context.Operation_data op1 :=
    protocol_data op1 in
  let 'Tezos_raw_protocol_alpha.Alpha_context.Operation_data op2 :=
    protocol_data op2 in
  match ((contents op1), (contents op2)) with
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Endorsement _),
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Endorsement _)) => 0
  |
    (_,
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Endorsement _)) => 1
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Endorsement _), _) => (-1)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation _),
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation _)) => 0
  |
    (_,
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation _)) => 1
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Seed_nonce_revelation _), _) =>
    (-1)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence _),
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence _))
    => 0
  |
    (_,
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence _))
    => 1
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Double_endorsement_evidence _), _)
    => (-1)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence _),
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence _)) => 0
  |
    (_,
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence _)) => 1
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Double_baking_evidence _), _) =>
    (-1)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Activate_account _),
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Activate_account _)) => 0
  |
    (_,
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Activate_account _)) => 1
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Activate_account _), _) => (-1)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Proposals _),
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Proposals _)) => 0
  |
    (_,
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Proposals _)) => 1
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Proposals _), _) => (-1)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Ballot _),
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Ballot _)) => 0
  |
    (_,
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Ballot _)) => 1
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Ballot _), _) => (-1)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation op1),
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation op2)) =>
    Z.compare (counter op1) (counter op2)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Cons
      (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation op1) _,
      Tezos_raw_protocol_alpha.Alpha_context.Single
        (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation op2)) =>
    Z.compare (counter op1) (counter op2)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Single
      (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation op1),
      Tezos_raw_protocol_alpha.Alpha_context.Cons
        (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation op2) _) =>
    Z.compare (counter op1) (counter op2)
  |
    (Tezos_raw_protocol_alpha.Alpha_context.Cons
      (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation op1) _,
      Tezos_raw_protocol_alpha.Alpha_context.Cons
        (Tezos_raw_protocol_alpha.Alpha_context.Manager_operation op2) _) =>
    Z.compare (counter op1) (counter op2)
  end.

Definition init
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  (block_header :
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Updater.validation_result) :=
  let level := Block_header.level block_header in
  let fitness := fitness block_header in
  let timestamp := timestamp block_header in
  let typecheck
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (script :
    Tezos_raw_protocol_alpha.Alpha_context.Script.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        ((Tezos_raw_protocol_alpha.Alpha_context.Script.t *
          option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff) *
          Tezos_raw_protocol_alpha.Alpha_context.context)) :=
    op_gtgteqquestion (Script_ir_translator.parse_script None ctxt false script)
      (fun function_parameter =>
        let
          '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_script
            parsed_script, ctxt) := function_parameter in
        op_gtgteqquestion
          (Script_ir_translator.extract_big_map_diff ctxt
            Tezos_raw_protocol_alpha.Script_ir_translator.Optimized false
            Script_ir_translator.no_big_map_id
            Script_ir_translator.no_big_map_id (storage_type parsed_script)
            (storage parsed_script))
          (fun function_parameter =>
            let '(storage, big_map_diff, ctxt) := function_parameter in
            op_gtgteqquestion
              (Script_ir_translator.unparse_data ctxt
                Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                (storage_type parsed_script) storage)
              (fun function_parameter =>
                let '(storage, ctxt) := function_parameter in
                let storage :=
                  Alpha_context.Script.lazy_expr
                    (Micheline.strip_locations storage) in
                __return
                  (((* ❌ Record substitution not handled *)
                  record_substitution, big_map_diff), ctxt)))) in
  op_gtgteqquestion
    (Alpha_context.prepare_first_block ctxt typecheck level timestamp fitness)
    (fun ctxt => __return (Alpha_context.finalize None ctxt)).
main.mli 9 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Tezos Protocol Implementation - Protocol Signature Instance *)

type validation_mode =
  | Application of {
      block_header : Alpha_context.Block_header.t;
      baker : Alpha_context.public_key_hash;
      block_delay : Alpha_context.Period.t;
    }
  | Partial_application of {
      block_header : Alpha_context.Block_header.t;
      baker : Alpha_context.public_key_hash;
      block_delay : Alpha_context.Period.t;
    }
  | Partial_construction of {predecessor : Block_hash.t}
  | Full_construction of {
      predecessor : Block_hash.t;
      protocol_data : Alpha_context.Block_header.contents;
      baker : Alpha_context.public_key_hash;
      block_delay : Alpha_context.Period.t;
    }

type validation_state = {
  mode : validation_mode;
  chain_id : Chain_id.t;
  ctxt : Alpha_context.t;
  op_count : int;
}

type operation_data = Alpha_context.packed_protocol_data

type operation = Alpha_context.packed_operation = {
  shell : Operation.shell_header;
  protocol_data : operation_data;
}

include
  Updater.PROTOCOL
    with type block_header_data = Alpha_context.Block_header.protocol_data
     and type block_header_metadata = Apply_results.block_metadata
     and type block_header = Alpha_context.Block_header.t
     and type operation_data := operation_data
     and type operation_receipt = Apply_results.packed_operation_metadata
     and type operation := operation
     and type validation_state := validation_state
main_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive validation_mode : Type :=
| Application : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t ->
  Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
  Tezos_raw_protocol_alpha.Alpha_context.Period.t -> validation_mode
| Partial_application : Tezos_raw_protocol_alpha.Alpha_context.Block_header.t ->
  Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
  Tezos_raw_protocol_alpha.Alpha_context.Period.t -> validation_mode
| Partial_construction :
  Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
  -> validation_mode
| Full_construction :
  Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
  -> Tezos_raw_protocol_alpha.Alpha_context.Block_header.contents ->
  Tezos_raw_protocol_alpha.Alpha_context.public_key_hash ->
  Tezos_raw_protocol_alpha.Alpha_context.Period.t -> validation_mode.

Record validation_state := {
  mode : validation_mode;
  chain_id :
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t);
  ctxt : Tezos_raw_protocol_alpha.Alpha_context.t;
  op_count : Z }.

Definition operation_data :=
  Tezos_raw_protocol_alpha.Alpha_context.packed_protocol_data.

Record operation := {
  shell : Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
  protocol_data : operation_data }.

include
manager_repr.ml 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* Tezos Protocol Implementation - Low level Repr. of Managers' keys *)

type manager_key =
  | Hash of Signature.Public_key_hash.t
  | Public_key of Signature.Public_key.t

type t = manager_key

open Data_encoding

let hash_case tag =
  case
    tag
    ~title:"Public_key_hash"
    Signature.Public_key_hash.encoding
    (function Hash hash -> Some hash | _ -> None)
    (fun hash -> Hash hash)

let pubkey_case tag =
  case
    tag
    ~title:"Public_key"
    Signature.Public_key.encoding
    (function Public_key hash -> Some hash | _ -> None)
    (fun hash -> Public_key hash)

let encoding = union [hash_case (Tag 0); pubkey_case (Tag 1)]
manager_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive manager_key : Type :=
| Hash :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  manager_key
| Public_key :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t ->
  manager_key.

Definition t := manager_key.

Import Data_encoding.

Definition hash_case
  (tag : Tezos_protocol_environment_alpha__Environment.Data_encoding.case_tag)
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.case manager_key :=
  case "Public_key_hash" % string None tag Signature.Public_key_hash.encoding
    (fun function_parameter =>
      match function_parameter with
      | Hash hash => Some hash
      | _ => None
      end) (fun hash => Hash hash).

Definition pubkey_case
  (tag : Tezos_protocol_environment_alpha__Environment.Data_encoding.case_tag)
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.case manager_key :=
  case "Public_key" % string None tag Signature.Public_key.encoding
    (fun function_parameter =>
      match function_parameter with
      | Public_key hash => Some hash
      | _ => None
      end) (fun hash => Public_key hash).

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    manager_key :=
  union None
    (cons
      (hash_case
        (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0))
      (cons
        (pubkey_case
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1))
        [])).
manager_repr.mli 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* Tezos Protocol Implementation - Low level Repr. of Managers' keys *)

(** The public key of the manager of a contract is reveled only after the
    first operation. At Origination time, the manager provides only the hash
    of its public key that is stored in the contract. When the public key
    is actually reveeld, the public key instead of the hash of the key *)
type manager_key =
  | Hash of Signature.Public_key_hash.t
  | Public_key of Signature.Public_key.t

type t = manager_key

val encoding : t Data_encoding.encoding
manager_repr_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive manager_key : Type :=
| Hash :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  manager_key
| Public_key :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t ->
  manager_key.

Definition t := manager_key.

Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t.
michelson_v1_gas.ml 16 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Gas

module Cost_of = struct
  let log2 =
    let rec help acc = function 0 -> acc | n -> help (acc + 1) (n / 2) in
    help 1

  let z_bytes (z : Z.t) =
    let bits = Z.numbits z in
    (7 + bits) / 8

  let int_bytes (z : 'a Script_int.num) = z_bytes (Script_int.to_zint z)

  let timestamp_bytes (t : Script_timestamp.t) =
    let z = Script_timestamp.to_zint t in
    z_bytes z

  (* For now, returns size in bytes, but this could get more complicated... *)
  let rec size_of_comparable :
      type a b. (a, b) Script_typed_ir.comparable_struct -> a -> int =
   fun wit v ->
    match wit with
    | Int_key _ ->
        int_bytes v
    | Nat_key _ ->
        int_bytes v
    | String_key _ ->
        String.length v
    | Bytes_key _ ->
        MBytes.length v
    | Bool_key _ ->
        8
    | Key_hash_key _ ->
        Signature.Public_key_hash.size
    | Timestamp_key _ ->
        timestamp_bytes v
    | Address_key _ ->
        Signature.Public_key_hash.size
    | Mutez_key _ ->
        8
    | Pair_key ((l, _), (r, _), _) ->
        let (lval, rval) = v in
        size_of_comparable l lval + size_of_comparable r rval

  let string length = alloc_bytes_cost length

  let bytes length = alloc_mbytes_cost length

  let manager_operation = step_cost 10_000

  module Legacy = struct
    let zint z = alloc_bits_cost (Z.numbits z)

    let set_to_list : type item. item Script_typed_ir.set -> cost =
     fun (module Box) -> alloc_cost @@ Pervasives.(Box.size * 2)

    let map_to_list : type key value. (key, value) Script_typed_ir.map -> cost
        =
     fun (module Box) ->
      let size = snd Box.boxed in
      3 *@ alloc_cost size

    let z_to_int64 = step_cost 2 +@ alloc_cost 1

    let hash data len = (10 *@ step_cost (MBytes.length data)) +@ bytes len

    let set_access : type elt. elt -> elt Script_typed_ir.set -> int =
     fun _key (module Box) -> log2 @@ Box.size

    let set_update key _presence set = set_access key set *@ alloc_cost 3
  end

  module Interpreter = struct
    let cycle = atomic_step_cost 10

    let nop = free

    let stack_op = atomic_step_cost 10

    let push = atomic_step_cost 10

    let wrap = atomic_step_cost 10

    let variant_no_data = atomic_step_cost 10

    let branch = atomic_step_cost 10

    let pair = atomic_step_cost 10

    let pair_access = atomic_step_cost 10

    let cons = atomic_step_cost 10

    let loop_size = atomic_step_cost 5

    let loop_cycle = atomic_step_cost 10

    let loop_iter = atomic_step_cost 20

    let loop_map = atomic_step_cost 30

    let empty_set = atomic_step_cost 10

    let set_to_list : type elt. elt Script_typed_ir.set -> cost =
     fun (module Box) -> atomic_step_cost (Box.size * 20)

    let set_mem : type elt. elt -> elt Script_typed_ir.set -> cost =
     fun elt (module Box) ->
      let elt_bytes = size_of_comparable Box.elt_ty elt in
      atomic_step_cost ((1 + (elt_bytes / 82)) * log2 Box.size)

    let set_update : type elt. elt -> bool -> elt Script_typed_ir.set -> cost =
     fun elt _ (module Box) ->
      let elt_bytes = size_of_comparable Box.elt_ty elt in
      atomic_step_cost ((1 + (elt_bytes / 82)) * log2 Box.size)

    let set_size = atomic_step_cost 10

    let empty_map = atomic_step_cost 10

    let map_to_list : type key value. (key, value) Script_typed_ir.map -> cost
        =
     fun (module Box) ->
      let size = snd Box.boxed in
      atomic_step_cost (size * 20)

    let map_access :
        type key value. key -> (key, value) Script_typed_ir.map -> cost =
     fun key (module Box) ->
      let map_card = snd Box.boxed in
      let key_bytes = size_of_comparable Box.key_ty key in
      atomic_step_cost ((1 + (key_bytes / 70)) * log2 map_card)

    let map_mem = map_access

    let map_get = map_access

    let map_update :
        type key value.
        key -> value option -> (key, value) Script_typed_ir.map -> cost =
     fun key _value (module Box) ->
      let map_card = snd Box.boxed in
      let key_bytes = size_of_comparable Box.key_ty key in
      atomic_step_cost ((1 + (key_bytes / 38)) * log2 map_card)

    let map_size = atomic_step_cost 10

    let add_timestamp (t1 : Script_timestamp.t) (t2 : 'a Script_int.num) =
      let bytes1 = timestamp_bytes t1 in
      let bytes2 = int_bytes t2 in
      atomic_step_cost (51 + (Compare.Int.max bytes1 bytes2 / 62))

    let sub_timestamp = add_timestamp

    let diff_timestamps (t1 : Script_timestamp.t) (t2 : Script_timestamp.t) =
      let bytes1 = timestamp_bytes t1 in
      let bytes2 = timestamp_bytes t2 in
      atomic_step_cost (51 + (Compare.Int.max bytes1 bytes2 / 62))

    let rec concat_loop l acc =
      match l with [] -> 30 | _ :: tl -> concat_loop tl (acc + 30)

    let concat_string string_list =
      atomic_step_cost (concat_loop string_list 0)

    let slice_string string_length =
      atomic_step_cost (40 + (string_length / 70))

    let concat_bytes bytes_list = atomic_step_cost (concat_loop bytes_list 0)

    let int64_op = atomic_step_cost 61

    let z_to_int64 = atomic_step_cost 20

    let int64_to_z = atomic_step_cost 20

    let bool_binop _ _ = atomic_step_cost 10

    let bool_unop _ = atomic_step_cost 10

    let abs int = atomic_step_cost (61 + (int_bytes int / 70))

    let int _int = free

    let neg = abs

    let add i1 i2 =
      atomic_step_cost
        (51 + (Compare.Int.max (int_bytes i1) (int_bytes i2) / 62))

    let sub = add

    let mul i1 i2 =
      let bytes = Compare.Int.max (int_bytes i1) (int_bytes i2) in
      atomic_step_cost (51 + (bytes / 6 * log2 bytes))

    let indic_lt x y = if Compare.Int.(x < y) then 1 else 0

    let div i1 i2 =
      let bytes1 = int_bytes i1 in
      let bytes2 = int_bytes i2 in
      let cost = indic_lt bytes2 bytes1 * (bytes1 - bytes2) * bytes2 in
      atomic_step_cost (51 + (cost / 3151))

    let shift_left _i _shift_bits = atomic_step_cost 30

    let shift_right _i _shift_bits = atomic_step_cost 30

    let logor i1 i2 =
      let bytes1 = int_bytes i1 in
      let bytes2 = int_bytes i2 in
      atomic_step_cost (51 + (Compare.Int.max bytes1 bytes2 / 70))

    let logand i1 i2 =
      let bytes1 = int_bytes i1 in
      let bytes2 = int_bytes i2 in
      atomic_step_cost (51 + (Compare.Int.min bytes1 bytes2 / 70))

    let logxor = logor

    let lognot i = atomic_step_cost (51 + (int_bytes i / 20))

    let exec = atomic_step_cost 10

    let compare_bool _ _ = atomic_step_cost 30

    let compare_string s1 s2 =
      let bytes1 = String.length s1 in
      let bytes2 = String.length s2 in
      atomic_step_cost (30 + (Compare.Int.min bytes1 bytes2 / 123))

    let compare_bytes b1 b2 =
      let bytes1 = MBytes.length b1 in
      let bytes2 = MBytes.length b2 in
      atomic_step_cost (30 + (Compare.Int.min bytes1 bytes2 / 123))

    let compare_tez _ _ = atomic_step_cost 30

    let compare_zint i1 i2 =
      atomic_step_cost
        (51 + (Compare.Int.min (int_bytes i1) (int_bytes i2) / 82))

    let compare_key_hash _ _ = atomic_step_cost 92

    let compare_timestamp t1 t2 =
      let bytes1 = timestamp_bytes t1 in
      let bytes2 = timestamp_bytes t2 in
      atomic_step_cost (51 + (Compare.Int.min bytes1 bytes2 / 82))

    let compare_address _ _ = atomic_step_cost 92

    let compare_res = atomic_step_cost 30

    let unpack_failed bytes =
      (* We cannot instrument failed deserialization,
         so we take worst case fees: a set of size 1 bytes values. *)
      let len = MBytes.length bytes in
      (len *@ alloc_mbytes_cost 1)
      +@ (len *@ (log2 len *@ (alloc_cost 3 +@ step_cost 1)))

    let address = atomic_step_cost 10

    let contract = step_cost 10000

    let transfer = step_cost 10

    let create_account = step_cost 10

    let create_contract = step_cost 10

    let implicit_account = step_cost 10

    let set_delegate = step_cost 10 +@ write_bytes_cost (Z.of_int 32)

    let balance = atomic_step_cost 10

    let now = atomic_step_cost 10

    let check_signature_secp256k1 bytes = atomic_step_cost (10342 + (bytes / 5))

    let check_signature_ed25519 bytes = atomic_step_cost (36864 + (bytes / 5))

    let check_signature_p256 bytes = atomic_step_cost (36864 + (bytes / 5))

    let check_signature (pkey : Signature.public_key) bytes =
      match pkey with
      | Ed25519 _ ->
          check_signature_ed25519 (MBytes.length bytes)
      | Secp256k1 _ ->
          check_signature_secp256k1 (MBytes.length bytes)
      | P256 _ ->
          check_signature_p256 (MBytes.length bytes)

    let hash_key = atomic_step_cost 30

    let hash_blake2b b = atomic_step_cost (102 + (MBytes.length b / 5))

    let hash_sha256 b = atomic_step_cost (409 + MBytes.length b)

    let hash_sha512 b =
      let bytes = MBytes.length b in
      atomic_step_cost (409 + ((bytes lsr 1) + (bytes lsr 4)))

    let steps_to_quota = atomic_step_cost 10

    let source = atomic_step_cost 10

    let self = atomic_step_cost 10

    let amount = atomic_step_cost 10

    let chain_id = step_cost 1

    let stack_n_op n =
      atomic_step_cost (20 + ((n lsr 1) + (n lsr 2) + (n lsr 4)))

    let apply = alloc_cost 8 +@ step_cost 1

    let rec compare :
        type a s. (a, s) Script_typed_ir.comparable_struct -> a -> a -> cost =
     fun ty x y ->
      match ty with
      | Bool_key _ ->
          compare_bool x y
      | String_key _ ->
          compare_string x y
      | Bytes_key _ ->
          compare_bytes x y
      | Mutez_key _ ->
          compare_tez x y
      | Int_key _ ->
          compare_zint x y
      | Nat_key _ ->
          compare_zint x y
      | Key_hash_key _ ->
          compare_key_hash x y
      | Timestamp_key _ ->
          compare_timestamp x y
      | Address_key _ ->
          compare_address x y
      | Pair_key ((tl, _), (tr, _), _) ->
          (* Reasonable over-approximation of the cost of lexicographic comparison. *)
          let (xl, xr) = x and (yl, yr) = y in
          compare tl xl yl +@ compare tr xr yr
  end

  module Typechecking = struct
    let cycle = step_cost 1

    let bool = free

    let unit = free

    let string = string

    let bytes = bytes

    let z = Legacy.zint

    let int_of_string str =
      alloc_cost @@ Pervasives.( / ) (String.length str) 5

    let tez = step_cost 1 +@ alloc_cost 1

    let string_timestamp = step_cost 3 +@ alloc_cost 3

    let key = step_cost 3 +@ alloc_cost 3

    let key_hash = step_cost 1 +@ alloc_cost 1

    let signature = step_cost 1 +@ alloc_cost 1

    let chain_id = step_cost 1 +@ alloc_cost 1

    let contract = step_cost 5

    let get_script = step_cost 20 +@ alloc_cost 5

    let contract_exists = step_cost 15 +@ alloc_cost 5

    let pair = alloc_cost 2

    let union = alloc_cost 1

    let lambda = alloc_cost 5 +@ step_cost 3

    let some = alloc_cost 1

    let none = alloc_cost 0

    let list_element = alloc_cost 2 +@ step_cost 1

    let set_element size = log2 size *@ (alloc_cost 3 +@ step_cost 2)

    let map_element size = log2 size *@ (alloc_cost 4 +@ step_cost 2)

    let primitive_type = alloc_cost 1

    let one_arg_type = alloc_cost 2

    let two_arg_type = alloc_cost 3

    let operation b = bytes b

    let type_ nb_args = alloc_cost (nb_args + 1)

    (* Cost of parsing instruction, is cost of allocation of
       constructor + cost of contructor parameters + cost of
       allocation on the stack type *)
    let instr : type b a. (b, a) Script_typed_ir.instr -> cost =
     fun i ->
      let open Script_typed_ir in
      alloc_cost 1
      +@
      (* cost of allocation of constructor *)
      match i with
      | Drop ->
          alloc_cost 0
      | Dup ->
          alloc_cost 1
      | Swap ->
          alloc_cost 0
      | Const _ ->
          alloc_cost 1
      | Cons_pair ->
          alloc_cost 2
      | Car ->
          alloc_cost 1
      | Cdr ->
          alloc_cost 1
      | Cons_some ->
          alloc_cost 2
      | Cons_none _ ->
          alloc_cost 3
      | If_none _ ->
          alloc_cost 2
      | Left ->
          alloc_cost 3
      | Right ->
          alloc_cost 3
      | If_left _ ->
          alloc_cost 2
      | Cons_list ->
          alloc_cost 1
      | Nil ->
          alloc_cost 1
      | If_cons _ ->
          alloc_cost 2
      | List_map _ ->
          alloc_cost 5
      | List_iter _ ->
          alloc_cost 4
      | List_size ->
          alloc_cost 1
      | Empty_set _ ->
          alloc_cost 1
      | Set_iter _ ->
          alloc_cost 4
      | Set_mem ->
          alloc_cost 1
      | Set_update ->
          alloc_cost 1
      | Set_size ->
          alloc_cost 1
      | Empty_map _ ->
          alloc_cost 2
      | Map_map _ ->
          alloc_cost 5
      | Map_iter _ ->
          alloc_cost 4
      | Map_mem ->
          alloc_cost 1
      | Map_get ->
          alloc_cost 1
      | Map_update ->
          alloc_cost 1
      | Map_size ->
          alloc_cost 1
      | Empty_big_map _ ->
          alloc_cost 2
      | Big_map_mem ->
          alloc_cost 1
      | Big_map_get ->
          alloc_cost 1
      | Big_map_update ->
          alloc_cost 1
      | Concat_string ->
          alloc_cost 1
      | Concat_string_pair ->
          alloc_cost 1
      | Concat_bytes ->
          alloc_cost 1
      | Concat_bytes_pair ->
          alloc_cost 1
      | Slice_string ->
          alloc_cost 1
      | Slice_bytes ->
          alloc_cost 1
      | String_size ->
          alloc_cost 1
      | Bytes_size ->
          alloc_cost 1
      | Add_seconds_to_timestamp ->
          alloc_cost 1
      | Add_timestamp_to_seconds ->
          alloc_cost 1
      | Sub_timestamp_seconds ->
          alloc_cost 1
      | Diff_timestamps ->
          alloc_cost 1
      | Add_tez ->
          alloc_cost 1
      | Sub_tez ->
          alloc_cost 1
      | Mul_teznat ->
          alloc_cost 1
      | Mul_nattez ->
          alloc_cost 1
      | Ediv_teznat ->
          alloc_cost 1
      | Ediv_tez ->
          alloc_cost 1
      | Or ->
          alloc_cost 1
      | And ->
          alloc_cost 1
      | Xor ->
          alloc_cost 1
      | Not ->
          alloc_cost 1
      | Is_nat ->
          alloc_cost 1
      | Neg_nat ->
          alloc_cost 1
      | Neg_int ->
          alloc_cost 1
      | Abs_int ->
          alloc_cost 1
      | Int_nat ->
          alloc_cost 1
      | Add_intint ->
          alloc_cost 1
      | Add_intnat ->
          alloc_cost 1
      | Add_natint ->
          alloc_cost 1
      | Add_natnat ->
          alloc_cost 1
      | Sub_int ->
          alloc_cost 1
      | Mul_intint ->
          alloc_cost 1
      | Mul_intnat ->
          alloc_cost 1
      | Mul_natint ->
          alloc_cost 1
      | Mul_natnat ->
          alloc_cost 1
      | Ediv_intint ->
          alloc_cost 1
      | Ediv_intnat ->
          alloc_cost 1
      | Ediv_natint ->
          alloc_cost 1
      | Ediv_natnat ->
          alloc_cost 1
      | Lsl_nat ->
          alloc_cost 1
      | Lsr_nat ->
          alloc_cost 1
      | Or_nat ->
          alloc_cost 1
      | And_nat ->
          alloc_cost 1
      | And_int_nat ->
          alloc_cost 1
      | Xor_nat ->
          alloc_cost 1
      | Not_nat ->
          alloc_cost 1
      | Not_int ->
          alloc_cost 1
      | Seq _ ->
          alloc_cost 8
      | If _ ->
          alloc_cost 8
      | Loop _ ->
          alloc_cost 4
      | Loop_left _ ->
          alloc_cost 5
      | Dip _ ->
          alloc_cost 4
      | Exec ->
          alloc_cost 1
      | Apply _ ->
          alloc_cost 1
      | Lambda _ ->
          alloc_cost 2
      | Failwith _ ->
          alloc_cost 1
      | Nop ->
          alloc_cost 0
      | Compare _ ->
          alloc_cost 1
      | Eq ->
          alloc_cost 1
      | Neq ->
          alloc_cost 1
      | Lt ->
          alloc_cost 1
      | Gt ->
          alloc_cost 1
      | Le ->
          alloc_cost 1
      | Ge ->
          alloc_cost 1
      | Address ->
          alloc_cost 1
      | Contract _ ->
          alloc_cost 2
      | Transfer_tokens ->
          alloc_cost 1
      | Create_account ->
          alloc_cost 2
      | Implicit_account ->
          alloc_cost 1
      | Create_contract _ ->
          alloc_cost 8
      (* Deducted the cost of removed arguments manager, spendable and delegatable:
           - manager: key_hash = 1
           - spendable: bool = 0
           - delegatable: bool = 0
        *)
      | Create_contract_2 _ ->
          alloc_cost 7
      | Set_delegate ->
          alloc_cost 1
      | Now ->
          alloc_cost 1
      | Balance ->
          alloc_cost 1
      | Check_signature ->
          alloc_cost 1
      | Hash_key ->
          alloc_cost 1
      | Pack _ ->
          alloc_cost 2
      | Unpack _ ->
          alloc_cost 2
      | Blake2b ->
          alloc_cost 1
      | Sha256 ->
          alloc_cost 1
      | Sha512 ->
          alloc_cost 1
      | Steps_to_quota ->
          alloc_cost 1
      | Source ->
          alloc_cost 1
      | Sender ->
          alloc_cost 1
      | Self _ ->
          alloc_cost 2
      | Amount ->
          alloc_cost 1
      | Dig (n, _) ->
          n *@ alloc_cost 1 (* _ is a unary development of n *)
      | Dug (n, _) ->
          n *@ alloc_cost 1
      | Dipn (n, _, _) ->
          n *@ alloc_cost 1
      | Dropn (n, _) ->
          n *@ alloc_cost 1
      | ChainId ->
          alloc_cost 1
  end

  module Unparse = struct
    let prim_cost l annot = Script.prim_node_cost_nonrec_of_length l annot

    let seq_cost = Script.seq_node_cost_nonrec_of_length

    let string_cost length = Script.string_node_cost_of_length length

    let cycle = step_cost 1

    let bool = prim_cost 0 []

    let unit = prim_cost 0 []

    (* We count the length of strings and bytes to prevent hidden
       miscalculations due to non detectable expansion of sharing. *)
    let string s = Script.string_node_cost s

    let bytes s = Script.bytes_node_cost s

    let z i = Script.int_node_cost i

    let int i = Script.int_node_cost (Script_int.to_zint i)

    let tez = Script.int_node_cost_of_numbits 60 (* int64 bound *)

    let timestamp x = Script_timestamp.to_zint x |> Script_int.of_zint |> int

    let operation bytes = Script.bytes_node_cost bytes

    let chain_id bytes = Script.bytes_node_cost bytes

    let key = string_cost 54

    let key_hash = string_cost 36

    let signature = string_cost 128

    let contract = string_cost 36

    let pair = prim_cost 2 []

    let union = prim_cost 1 []

    let some = prim_cost 1 []

    let none = prim_cost 0 []

    let list_element = alloc_cost 2

    let set_element = alloc_cost 2

    let map_element = alloc_cost 2

    let one_arg_type = prim_cost 1

    let two_arg_type = prim_cost 2

    let set_to_list = Legacy.set_to_list

    let map_to_list = Legacy.map_to_list
  end
end
michelson_v1_gas_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Import Gas.

Module Cost_of.
  Definition log2 : Z -> Z :=
    let fix help (acc : Z) (function_parameter : Z) : Z :=
      match function_parameter with
      | 0 => acc
      | n => help (op_plus acc 1) (op_div n 2)
      end in
    help 1.
  
  Definition z_bytes (z : Tezos_protocol_environment_alpha__Environment.Z.t)
    : Z :=
    let bits := Z.numbits z in
    op_div (op_plus 7 bits) 8.
  
  Definition int_bytes {a : Type}
    (z : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num a) : Z :=
    z_bytes (Script_int.to_zint z).
  
  Definition timestamp_bytes
    (t : Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t) : Z :=
    let z := Script_timestamp.to_zint t in
    z_bytes z.
  
  Fixpoint size_of_comparable {a b : Type}
    (wit : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_struct a b)
    (v : a) : Z :=
    match wit with
    | Tezos_raw_protocol_alpha.Script_typed_ir.Int_key _ => int_bytes v
    | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key _ => int_bytes v
    | Tezos_raw_protocol_alpha.Script_typed_ir.String_key _ => String.length v
    | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key _ => MBytes.length v
    | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key _ => 8
    | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key _ =>
      Signature.Public_key_hash.size
    | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key _ =>
      timestamp_bytes v
    | Tezos_raw_protocol_alpha.Script_typed_ir.Address_key _ =>
      Signature.Public_key_hash.size
    | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key _ => 8
    | Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key (l, _) (r, _) _ =>
      let '(lval, rval) := v in
      op_plus (size_of_comparable l lval) (size_of_comparable r rval)
    end.
  
  Definition string (length : Z)
    : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := alloc_bytes_cost length.
  
  Definition bytes (length : Z)
    : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
    alloc_mbytes_cost length.
  
  Definition manager_operation
    : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := step_cost 10000.
  
  Module Legacy.
    Definition zint (z : Tezos_protocol_environment_alpha__Environment.Z.t)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_bits_cost (Z.numbits z).
    
    Definition set_to_list {item : Type}
      (Box : Tezos_raw_protocol_alpha.Script_typed_ir.set item)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let Box := projT2 Box in
      op_atat alloc_cost
        (op_star Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_set.size)
          2).
    
    Definition map_to_list {key value : Type}
      (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map key value)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let Box := projT2 Box in
      let size :=
        snd Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_map.boxed) in
      op_starat 3 (alloc_cost size).
    
    Definition z_to_int64 : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (step_cost 2) (alloc_cost 1).
    
    Definition hash
      (data : Tezos_protocol_environment_alpha__Environment.MBytes.t) (len : Z)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (op_starat 10 (step_cost (MBytes.length data))) (string len).
    
    Definition set_access {elt : Type}
      (_key : elt) (Box : Tezos_raw_protocol_alpha.Script_typed_ir.set elt)
      : Z :=
      let Box := projT2 Box in
      op_atat log2
        Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_set.size).
    
    Definition set_update {A B : Type}
      (key : A) (_presence : B)
      (set : Tezos_raw_protocol_alpha.Script_typed_ir.set A)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_starat (set_access key set) (alloc_cost 3).
  End Legacy.
  
  Module Interpreter.
    Definition cycle : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition nop : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := free.
    
    Definition stack_op : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition push : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition wrap : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition variant_no_data
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := atomic_step_cost 10.
    
    Definition branch : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition pair : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition pair_access : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition cons : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition loop_size : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 5.
    
    Definition loop_cycle : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition loop_iter : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 20.
    
    Definition loop_map : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 30.
    
    Definition empty_set : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition set_to_list {elt : Type}
      (Box : Tezos_raw_protocol_alpha.Script_typed_ir.set elt)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let Box := projT2 Box in
      atomic_step_cost
        (op_star Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_set.size)
          20).
    
    Definition set_mem {elt : Type}
      (elt : elt) (Box : Tezos_raw_protocol_alpha.Script_typed_ir.set elt)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let Box := projT2 Box in
      let elt_bytes :=
        size_of_comparable
          Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_set.elt_ty) elt
        in
      atomic_step_cost
        (op_star (op_plus 1 (op_div elt_bytes 82))
          (log2 Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_set.size))).
    
    Definition set_update {elt : Type} (elt : elt) (function_parameter : bool)
      : Tezos_raw_protocol_alpha.Script_typed_ir.set elt ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let '_ := function_parameter in
      fun Box =>
        let Box := projT2 Box in
        let elt_bytes :=
          size_of_comparable
            Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_set.elt_ty) elt
          in
        atomic_step_cost
          (op_star (op_plus 1 (op_div elt_bytes 82))
            (log2 Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_set.size))).
    
    Definition set_size : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition empty_map : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition map_to_list {key value : Type}
      (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map key value)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let Box := projT2 Box in
      let size :=
        snd Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_map.boxed) in
      atomic_step_cost (op_star size 20).
    
    Definition map_access {key value : Type}
      (key : key) (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map key value)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let Box := projT2 Box in
      let map_card :=
        snd Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_map.boxed) in
      let key_bytes :=
        size_of_comparable
          Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_map.key_ty) key
        in
      atomic_step_cost
        (op_star (op_plus 1 (op_div key_bytes 70)) (log2 map_card)).
    
    Definition map_mem {A B : Type}
      : A ->
        Tezos_raw_protocol_alpha.Script_typed_ir.map A B ->
          Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := map_access.
    
    Definition map_get {A B : Type}
      : A ->
        Tezos_raw_protocol_alpha.Script_typed_ir.map A B ->
          Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := map_access.
    
    Definition map_update {key value : Type}
      (key : key) (_value : option value)
      (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map key value)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let Box := projT2 Box in
      let map_card :=
        snd Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_map.boxed) in
      let key_bytes :=
        size_of_comparable
          Box.(Tezos_raw_protocol_alpha__Script_typed_ir.Boxed_map.key_ty) key
        in
      atomic_step_cost
        (op_star (op_plus 1 (op_div key_bytes 38)) (log2 map_card)).
    
    Definition map_size : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition add_timestamp {a : Type}
      (t1 : Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t)
      (t2 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num a)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let bytes1 := timestamp_bytes t1 in
      let bytes2 := int_bytes t2 in
      atomic_step_cost
        (op_plus 51
          (op_div
            (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.max)
              bytes1 bytes2) 62)).
    
    Definition sub_timestamp {A : Type}
      : Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t ->
        Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A ->
          Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := add_timestamp.
    
    Definition diff_timestamps
      (t1 : Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t)
      (t2 : Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let bytes1 := timestamp_bytes t1 in
      let bytes2 := timestamp_bytes t2 in
      atomic_step_cost
        (op_plus 51
          (op_div
            (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.max)
              bytes1 bytes2) 62)).
    
    Fixpoint concat_loop {A : Type} (l : list A) (acc : Z) : Z :=
      match l with
      | [] => 30
      | cons _ tl => concat_loop tl (op_plus acc 30)
      end.
    
    Definition concat_string {A : Type} (string_list : list A)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost (concat_loop string_list 0).
    
    Definition slice_string (string_length : Z)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost (op_plus 40 (op_div string_length 70)).
    
    Definition concat_bytes {A : Type} (bytes_list : list A)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost (concat_loop bytes_list 0).
    
    Definition int64_op : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 61.
    
    Definition z_to_int64 : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 20.
    
    Definition int64_to_z : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 20.
    
    Definition bool_binop {A B : Type} (function_parameter : A)
      : B -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let '_ := function_parameter in
      fun function_parameter =>
        let '_ := function_parameter in
        atomic_step_cost 10.
    
    Definition bool_unop {A : Type} (function_parameter : A)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let '_ := function_parameter in
      atomic_step_cost 10.
    
    Definition abs {A : Type}
      (int : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost (op_plus 61 (op_div (int_bytes Z) 70)).
    
    Definition int {A : Type} (_int : A)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := free.
    
    Definition neg {A : Type}
      : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := abs.
    
    Definition add {A B : Type}
      (i1 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A)
      (i2 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num B)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost
        (op_plus 51
          (op_div
            (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.max)
              (int_bytes i1) (int_bytes i2)) 62)).
    
    Definition sub {A B : Type}
      : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A ->
        Tezos_raw_protocol_alpha.Alpha_context.Script_int.num B ->
          Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := add.
    
    Definition mul {A B : Type}
      (i1 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A)
      (i2 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num B)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let bytes :=
        Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.max)
          (int_bytes i1) (int_bytes i2) in
      atomic_step_cost (op_plus 51 (op_star (op_div string 6) (log2 string))).
    
    Definition indic_lt
      (x :
        Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
      (y :
        Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
      : Z :=
      if
        Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
          x y then
        1
      else
        0.
    
    Definition div {A B : Type}
      (i1 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A)
      (i2 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num B)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let bytes1 := int_bytes i1 in
      let bytes2 := int_bytes i2 in
      let cost :=
        op_star (op_star (indic_lt bytes2 bytes1) (op_minus bytes1 bytes2))
          bytes2 in
      atomic_step_cost (op_plus 51 (op_div cost 3151)).
    
    Definition shift_left {A B : Type} (_i : A) (_shift_bits : B)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := atomic_step_cost 30.
    
    Definition shift_right {A B : Type} (_i : A) (_shift_bits : B)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := atomic_step_cost 30.
    
    Definition logor {A B : Type}
      (i1 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A)
      (i2 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num B)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let bytes1 := int_bytes i1 in
      let bytes2 := int_bytes i2 in
      atomic_step_cost
        (op_plus 51
          (op_div
            (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.max)
              bytes1 bytes2) 70)).
    
    Definition logand {A B : Type}
      (i1 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A)
      (i2 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num B)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let bytes1 := int_bytes i1 in
      let bytes2 := int_bytes i2 in
      atomic_step_cost
        (op_plus 51
          (op_div
            (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.min)
              bytes1 bytes2) 70)).
    
    Definition logxor {A B : Type}
      : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A ->
        Tezos_raw_protocol_alpha.Alpha_context.Script_int.num B ->
          Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := logor.
    
    Definition lognot {A : Type}
      (i : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost (op_plus 51 (op_div (int_bytes i) 20)).
    
    Definition exec : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition compare_bool {A B : Type} (function_parameter : A)
      : B -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let '_ := function_parameter in
      fun function_parameter =>
        let '_ := function_parameter in
        atomic_step_cost 30.
    
    Definition compare_string (s1 : string) (s2 : string)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let bytes1 := String.length s1 in
      let bytes2 := String.length s2 in
      atomic_step_cost
        (op_plus 30
          (op_div
            (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.min)
              bytes1 bytes2) 123)).
    
    Definition compare_bytes
      (b1 : Tezos_protocol_environment_alpha__Environment.MBytes.t)
      (b2 : Tezos_protocol_environment_alpha__Environment.MBytes.t)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let bytes1 := MBytes.length b1 in
      let bytes2 := MBytes.length b2 in
      atomic_step_cost
        (op_plus 30
          (op_div
            (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.min)
              bytes1 bytes2) 123)).
    
    Definition compare_tez {A B : Type} (function_parameter : A)
      : B -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let '_ := function_parameter in
      fun function_parameter =>
        let '_ := function_parameter in
        atomic_step_cost 30.
    
    Definition compare_zint {A B : Type}
      (i1 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A)
      (i2 : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num B)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost
        (op_plus 51
          (op_div
            (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.min)
              (int_bytes i1) (int_bytes i2)) 82)).
    
    Definition compare_key_hash {A B : Type} (function_parameter : A)
      : B -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let '_ := function_parameter in
      fun function_parameter =>
        let '_ := function_parameter in
        atomic_step_cost 92.
    
    Definition compare_timestamp
      (t1 : Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t)
      (t2 : Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let bytes1 := timestamp_bytes t1 in
      let bytes2 := timestamp_bytes t2 in
      atomic_step_cost
        (op_plus 51
          (op_div
            (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.min)
              bytes1 bytes2) 82)).
    
    Definition compare_address {A B : Type} (function_parameter : A)
      : B -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let '_ := function_parameter in
      fun function_parameter =>
        let '_ := function_parameter in
        atomic_step_cost 92.
    
    Definition compare_res : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 30.
    
    Definition unpack_failed
      (bytes : Tezos_protocol_environment_alpha__Environment.MBytes.t)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let len := MBytes.length string in
      op_plusat (op_starat len (alloc_mbytes_cost 1))
        (op_starat len
          (op_starat (log2 len) (op_plusat (alloc_cost 3) (step_cost 1)))).
    
    Definition address : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition contract : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      step_cost 10000.
    
    Definition transfer : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      step_cost 10.
    
    Definition create_account
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := step_cost 10.
    
    Definition create_contract
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := step_cost 10.
    
    Definition implicit_account
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := step_cost 10.
    
    Definition set_delegate : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (step_cost 10) (write_bytes_cost (Z.of_int 32)).
    
    Definition balance : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition now : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition check_signature_secp256k1 (bytes : Z)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost (op_plus 10342 (op_div string 5)).
    
    Definition check_signature_ed25519 (bytes : Z)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost (op_plus 36864 (op_div string 5)).
    
    Definition check_signature_p256 (bytes : Z)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost (op_plus 36864 (op_div string 5)).
    
    Definition check_signature
      (pkey : Tezos_protocol_environment_alpha__Environment.Signature.public_key)
      (bytes : Tezos_protocol_environment_alpha__Environment.MBytes.t)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      match pkey with
      | Tezos_protocol_environment_alpha__Environment.Signature.Ed25519 _ =>
        check_signature_ed25519 (MBytes.length string)
      | Tezos_protocol_environment_alpha__Environment.Signature.Secp256k1 _ =>
        check_signature_secp256k1 (MBytes.length string)
      | Tezos_protocol_environment_alpha__Environment.Signature.P256 _ =>
        check_signature_p256 (MBytes.length string)
      end.
    
    Definition hash_key : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 30.
    
    Definition hash_blake2b
      (b : Tezos_protocol_environment_alpha__Environment.MBytes.t)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost (op_plus 102 (op_div (MBytes.length b) 5)).
    
    Definition hash_sha256
      (b : Tezos_protocol_environment_alpha__Environment.MBytes.t)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost (op_plus 409 (MBytes.length b)).
    
    Definition hash_sha512
      (b : Tezos_protocol_environment_alpha__Environment.MBytes.t)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      let bytes := MBytes.length b in
      atomic_step_cost (op_plus 409 (op_plus (lsr string 1) (lsr string 4))).
    
    Definition steps_to_quota
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := atomic_step_cost 10.
    
    Definition source : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition self : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition amount : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost 10.
    
    Definition chain_id : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      step_cost 1.
    
    Definition stack_n_op (n : Z)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      atomic_step_cost
        (op_plus 20 (op_plus (op_plus (lsr n 1) (lsr n 2)) (lsr n 4))).
    
    Definition apply : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (alloc_cost 8) (step_cost 1).
    
    Fixpoint compare {a s : Type}
      (ty : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_struct a s)
      (x : a) (y : a) : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      match ty with
      | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key _ => compare_bool x y
      | Tezos_raw_protocol_alpha.Script_typed_ir.String_key _ =>
        compare_string x y
      | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key _ =>
        compare_bytes x y
      | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key _ => compare_tez x y
      | Tezos_raw_protocol_alpha.Script_typed_ir.Int_key _ => compare_zint x y
      | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key _ => compare_zint x y
      | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key _ =>
        compare_key_hash x y
      | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key _ =>
        compare_timestamp x y
      | Tezos_raw_protocol_alpha.Script_typed_ir.Address_key _ =>
        compare_address x y
      | Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key (tl, _) (tr, _) _ =>
        in
        op_plusat (compare tl xl yl) (compare tr xr yr)
      end.
  End Interpreter.
  
  Module Typechecking.
    Definition cycle : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      step_cost 1.
    
    Definition bool : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := free.
    
    Definition unit : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := free.
    
    Definition string : Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      string.
    
    Definition bytes : Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      string.
    
    Definition z
      : Tezos_protocol_environment_alpha__Environment.Z.t ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := Legacy.zint.
    
    Definition int_of_string (str : string)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_atat alloc_cost (Pervasives.op_div (String.length str) 5).
    
    Definition tez : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (step_cost 1) (alloc_cost 1).
    
    Definition string_timestamp
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (step_cost 3) (alloc_cost 3).
    
    Definition key : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (step_cost 3) (alloc_cost 3).
    
    Definition key_hash : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (step_cost 1) (alloc_cost 1).
    
    Definition signature : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (step_cost 1) (alloc_cost 1).
    
    Definition chain_id : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (step_cost 1) (alloc_cost 1).
    
    Definition contract : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      step_cost 5.
    
    Definition get_script : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (step_cost 20) (alloc_cost 5).
    
    Definition contract_exists
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (step_cost 15) (alloc_cost 5).
    
    Definition pair : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_cost 2.
    
    Definition union : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_cost 1.
    
    Definition lambda : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (alloc_cost 5) (step_cost 3).
    
    Definition some : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_cost 1.
    
    Definition none : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_cost 0.
    
    Definition list_element : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (alloc_cost 2) (step_cost 1).
    
    Definition set_element (size : Z)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_starat (log2 size) (op_plusat (alloc_cost 3) (step_cost 2)).
    
    Definition map_element (size : Z)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_starat (log2 size) (op_plusat (alloc_cost 4) (step_cost 2)).
    
    Definition primitive_type
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := alloc_cost 1.
    
    Definition one_arg_type : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_cost 2.
    
    Definition two_arg_type : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_cost 3.
    
    Definition operation (b : Z)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := string b.
    
    Definition type_ (nb_args : Z)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_cost (op_plus nb_args 1).
    
    Definition instr {a b : Type}
      (i : Tezos_raw_protocol_alpha.Script_typed_ir.instr b a)
      : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      op_plusat (alloc_cost 1)
        match i with
        | Tezos_raw_protocol_alpha.Script_typed_ir.Drop => alloc_cost 0
        | Tezos_raw_protocol_alpha.Script_typed_ir.Dup => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Swap => alloc_cost 0
        | Tezos_raw_protocol_alpha.Script_typed_ir.Const _ => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Cons_pair => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Car => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Cdr => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Cons_some => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Cons_none _ => alloc_cost 3
        | Tezos_raw_protocol_alpha.Script_typed_ir.If_none _ _ => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Left => alloc_cost 3
        | Tezos_raw_protocol_alpha.Script_typed_ir.Right => alloc_cost 3
        | Tezos_raw_protocol_alpha.Script_typed_ir.If_left _ _ => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Cons_list => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Nil => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.If_cons _ _ => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.List_map _ => alloc_cost 5
        | Tezos_raw_protocol_alpha.Script_typed_ir.List_iter _ => alloc_cost 4
        | Tezos_raw_protocol_alpha.Script_typed_ir.List_size => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Empty_set _ => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Set_iter _ => alloc_cost 4
        | Tezos_raw_protocol_alpha.Script_typed_ir.Set_mem => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Set_update => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Set_size => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Empty_map _ _ => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Map_map _ => alloc_cost 5
        | Tezos_raw_protocol_alpha.Script_typed_ir.Map_iter _ => alloc_cost 4
        | Tezos_raw_protocol_alpha.Script_typed_ir.Map_mem => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Map_get => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Map_update => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Map_size => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Empty_big_map _ _ =>
          alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_mem => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_get => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_update =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Concat_string => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Concat_string_pair =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Concat_bytes => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Concat_bytes_pair =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Slice_string => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Slice_bytes => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.String_size => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_size => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Add_seconds_to_timestamp =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Add_timestamp_to_seconds =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Sub_timestamp_seconds =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Diff_timestamps =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Add_tez => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Sub_tez => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_teznat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_nattez => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_teznat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_tez => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Or => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.And => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Xor => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Not => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Is_nat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Neg_nat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Neg_int => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Abs_int => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Int_nat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Add_intint => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Add_intnat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Add_natint => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Add_natnat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Sub_int => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_intint => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_intnat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_natint => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_natnat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_intint => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_intnat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_natint => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_natnat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Lsl_nat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Lsr_nat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Or_nat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.And_nat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.And_int_nat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Xor_nat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Not_nat => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Not_int => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Seq _ _ => alloc_cost 8
        | Tezos_raw_protocol_alpha.Script_typed_ir.If _ _ => alloc_cost 8
        | Tezos_raw_protocol_alpha.Script_typed_ir.Loop _ => alloc_cost 4
        | Tezos_raw_protocol_alpha.Script_typed_ir.Loop_left _ => alloc_cost 5
        | Tezos_raw_protocol_alpha.Script_typed_ir.Dip _ => alloc_cost 4
        | Tezos_raw_protocol_alpha.Script_typed_ir.Exec => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Apply _ => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Lambda _ => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Failwith _ => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Nop => alloc_cost 0
        | Tezos_raw_protocol_alpha.Script_typed_ir.Compare _ => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Eq => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Neq => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Lt => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Gt => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Le => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Ge => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Address => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Contract _ _ => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Transfer_tokens =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Create_account =>
          alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Implicit_account =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Create_contract _ _ _ _ =>
          alloc_cost 8
        | Tezos_raw_protocol_alpha.Script_typed_ir.Create_contract_2 _ _ _ _ =>
          alloc_cost 7
        | Tezos_raw_protocol_alpha.Script_typed_ir.Set_delegate => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Now => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Balance => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Check_signature =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Hash_key => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Pack _ => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Unpack _ => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Blake2b => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Sha256 => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Sha512 => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Steps_to_quota =>
          alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Source => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Sender => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Self _ _ => alloc_cost 2
        | Tezos_raw_protocol_alpha.Script_typed_ir.Amount => alloc_cost 1
        | Tezos_raw_protocol_alpha.Script_typed_ir.Dig n _ =>
          op_starat n (alloc_cost 1)
        | Tezos_raw_protocol_alpha.Script_typed_ir.Dug n _ =>
          op_starat n (alloc_cost 1)
        | Tezos_raw_protocol_alpha.Script_typed_ir.Dipn n _ _ =>
          op_starat n (alloc_cost 1)
        | Tezos_raw_protocol_alpha.Script_typed_ir.Dropn n _ =>
          op_starat n (alloc_cost 1)
        | Tezos_raw_protocol_alpha.Script_typed_ir.ChainId => alloc_cost 1
        end.
  End Typechecking.
  
  Module Unparse.
    Definition prim_cost
      (l : Z) (annot : Tezos_raw_protocol_alpha.Alpha_context.Script.annot)
      : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      Script.prim_node_cost_nonrec_of_length l annot.
    
    Definition seq_cost
      : Z -> Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      Script.seq_node_cost_nonrec_of_length.
    
    Definition string_cost (length : Z)
      : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      Script.string_node_cost_of_length length.
    
    Definition cycle : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      step_cost 1.
    
    Definition bool : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      prim_cost 0 [].
    
    Definition unit : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      prim_cost 0 [].
    
    Definition string (s : string)
      : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      Script.string_node_cost s.
    
    Definition bytes
      (s : Tezos_protocol_environment_alpha__Environment.MBytes.t)
      : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      Script.bytes_node_cost s.
    
    Definition z (i : Tezos_protocol_environment_alpha__Environment.Z.t)
      : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      Script.int_node_cost i.
    
    Definition int {A : Type}
      (i : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num A)
      : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      Script.int_node_cost (Script_int.to_zint i).
    
    Definition tez : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      Script.int_node_cost_of_numbits 60.
    
    Definition timestamp
      (x : Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t)
      : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      op_pipegt (op_pipegt (Script_timestamp.to_zint x) Script_int.of_zint) Z.
    
    Definition operation
      (bytes : Tezos_protocol_environment_alpha__Environment.MBytes.t)
      : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      Script.bytes_node_cost string.
    
    Definition chain_id
      (bytes : Tezos_protocol_environment_alpha__Environment.MBytes.t)
      : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      Script.bytes_node_cost string.
    
    Definition key : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      string_cost 54.
    
    Definition key_hash : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      string_cost 36.
    
    Definition signature : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      string_cost 128.
    
    Definition contract : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      string_cost 36.
    
    Definition pair : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      prim_cost 2 [].
    
    Definition union : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      prim_cost 1 [].
    
    Definition some : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      prim_cost 1 [].
    
    Definition none : Tezos_raw_protocol_alpha__Alpha_context.Gas.cost :=
      prim_cost 0 [].
    
    Definition list_element : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_cost 2.
    
    Definition set_element : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_cost 2.
    
    Definition map_element : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost :=
      alloc_cost 2.
    
    Definition one_arg_type
      : Tezos_raw_protocol_alpha.Alpha_context.Script.annot ->
        Tezos_raw_protocol_alpha__Alpha_context.Gas.cost := prim_cost 1.
    
    Definition two_arg_type
      : Tezos_raw_protocol_alpha.Alpha_context.Script.annot ->
        Tezos_raw_protocol_alpha__Alpha_context.Gas.cost := prim_cost 2.
    
    Definition set_to_list {A : Type}
      : Tezos_raw_protocol_alpha.Script_typed_ir.set A ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := Legacy.set_to_list.
    
    Definition map_to_list {A B : Type}
      : Tezos_raw_protocol_alpha.Script_typed_ir.map A B ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost := Legacy.map_to_list.
  End Unparse.
End Cost_of.
michelson_v1_gas.mli 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

module Cost_of : sig
  val manager_operation : Gas.cost

  module Legacy : sig
    val z_to_int64 : Gas.cost

    val hash : MBytes.t -> int -> Gas.cost

    val map_to_list : ('b, 'c) Script_typed_ir.map -> Gas.cost

    val set_update : 'a -> bool -> 'a Script_typed_ir.set -> Gas.cost
  end

  module Interpreter : sig
    val cycle : Gas.cost

    val loop_cycle : Gas.cost

    val loop_size : Gas.cost

    val loop_iter : Gas.cost

    val loop_map : Gas.cost

    val nop : Gas.cost

    val stack_op : Gas.cost

    val stack_n_op : int -> Gas.cost

    val bool_binop : 'a -> 'b -> Gas.cost

    val bool_unop : 'a -> Gas.cost

    val pair : Gas.cost

    val pair_access : Gas.cost

    val cons : Gas.cost

    val variant_no_data : Gas.cost

    val branch : Gas.cost

    val concat_string : string list -> Gas.cost

    val concat_bytes : MBytes.t list -> Gas.cost

    val slice_string : int -> Gas.cost

    val map_mem : 'a -> ('a, 'b) Script_typed_ir.map -> Gas.cost

    val map_to_list : ('a, 'b) Script_typed_ir.map -> Gas.cost

    val map_get : 'a -> ('a, 'b) Script_typed_ir.map -> Gas.cost

    val map_update :
      'a -> 'b option -> ('a, 'b) Script_typed_ir.map -> Gas.cost

    val map_size : Gas.cost

    val set_to_list : 'a Script_typed_ir.set -> Gas.cost

    val set_update : 'a -> bool -> 'a Script_typed_ir.set -> Gas.cost

    val set_mem : 'a -> 'a Script_typed_ir.set -> Gas.cost

    val mul : 'a Script_int.num -> 'b Script_int.num -> Gas.cost

    val div : 'a Script_int.num -> 'b Script_int.num -> Gas.cost

    val add : 'a Script_int.num -> 'b Script_int.num -> Gas.cost

    val sub : 'a Script_int.num -> 'b Script_int.num -> Gas.cost

    val abs : 'a Script_int.num -> Gas.cost

    val neg : 'a Script_int.num -> Gas.cost

    val int : 'a -> Gas.cost

    val add_timestamp : Script_timestamp.t -> 'a Script_int.num -> Gas.cost

    val sub_timestamp : Script_timestamp.t -> 'a Script_int.num -> Gas.cost

    val diff_timestamps : Script_timestamp.t -> Script_timestamp.t -> Gas.cost

    val empty_set : Gas.cost

    val set_size : Gas.cost

    val empty_map : Gas.cost

    val int64_op : Gas.cost

    val z_to_int64 : Gas.cost

    val int64_to_z : Gas.cost

    val logor : 'a Script_int.num -> 'b Script_int.num -> Gas.cost

    val logand : 'a Script_int.num -> 'b Script_int.num -> Gas.cost

    val logxor : 'a Script_int.num -> 'b Script_int.num -> Gas.cost

    val lognot : 'a Script_int.num -> Gas.cost

    val shift_left : 'a Script_int.num -> 'b Script_int.num -> Gas.cost

    val shift_right : 'a Script_int.num -> 'b Script_int.num -> Gas.cost

    val exec : Gas.cost

    val push : Gas.cost

    val compare_res : Gas.cost

    val unpack_failed : MBytes.t -> Gas.cost

    val address : Gas.cost

    val contract : Gas.cost

    val transfer : Gas.cost

    val create_account : Gas.cost

    val create_contract : Gas.cost

    val implicit_account : Gas.cost

    val set_delegate : Gas.cost

    val balance : Gas.cost

    val now : Gas.cost

    val check_signature : public_key -> MBytes.t -> Gas.cost

    val hash_key : Gas.cost

    val hash_blake2b : MBytes.t -> Gas.cost

    val hash_sha256 : MBytes.t -> Gas.cost

    val hash_sha512 : MBytes.t -> Gas.cost

    val steps_to_quota : Gas.cost

    val source : Gas.cost

    val self : Gas.cost

    val amount : Gas.cost

    val chain_id : Gas.cost

    val wrap : Gas.cost

    val compare : 'a Script_typed_ir.comparable_ty -> 'a -> 'a -> Gas.cost

    val apply : Gas.cost
  end

  module Typechecking : sig
    val cycle : Gas.cost

    val unit : Gas.cost

    val bool : Gas.cost

    val tez : Gas.cost

    val z : Z.t -> Gas.cost

    val string : int -> Gas.cost

    val bytes : int -> Gas.cost

    val int_of_string : string -> Gas.cost

    val string_timestamp : Gas.cost

    val key : Gas.cost

    val key_hash : Gas.cost

    val signature : Gas.cost

    val chain_id : Gas.cost

    val contract : Gas.cost

    (** Gas.Cost of getting the code for a contract *)
    val get_script : Gas.cost

    val contract_exists : Gas.cost

    (** Additional Gas.cost of parsing a pair over the Gas.cost of parsing each type  *)
    val pair : Gas.cost

    val union : Gas.cost

    val lambda : Gas.cost

    val some : Gas.cost

    val none : Gas.cost

    val list_element : Gas.cost

    val set_element : int -> Gas.cost

    val map_element : int -> Gas.cost

    val primitive_type : Gas.cost

    val one_arg_type : Gas.cost

    val two_arg_type : Gas.cost

    val operation : int -> Gas.cost

    (** Cost of parsing a type *)
    val type_ : int -> Gas.cost

    (** Cost of parsing an instruction *)
    val instr : ('a, 'b) Script_typed_ir.instr -> Gas.cost
  end

  module Unparse : sig
    val prim_cost : int -> Script.annot -> Gas.cost

    val seq_cost : int -> Gas.cost

    val cycle : Gas.cost

    val unit : Gas.cost

    val bool : Gas.cost

    val z : Z.t -> Gas.cost

    val int : 'a Script_int.num -> Gas.cost

    val tez : Gas.cost

    val string : string -> Gas.cost

    val bytes : MBytes.t -> Gas.cost

    val timestamp : Script_timestamp.t -> Gas.cost

    val key : Gas.cost

    val key_hash : Gas.cost

    val signature : Gas.cost

    val operation : MBytes.t -> Gas.cost

    val chain_id : MBytes.t -> Gas.cost

    val contract : Gas.cost

    (** Additional Gas.cost of parsing a pair over the Gas.cost of parsing each type  *)
    val pair : Gas.cost

    val union : Gas.cost

    val some : Gas.cost

    val none : Gas.cost

    val list_element : Gas.cost

    val set_element : Gas.cost

    val map_element : Gas.cost

    val one_arg_type : Script.annot -> Gas.cost

    val two_arg_type : Script.annot -> Gas.cost

    val set_to_list : 'a Script_typed_ir.set -> Gas.cost

    val map_to_list : ('a, 'b) Script_typed_ir.map -> Gas.cost
  end
end
michelson_v1_gas_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module Cost_of.
  Parameter manager_operation : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
  
  Module Legacy.
    Parameter z_to_int64 : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter hash : Tezos_protocol_environment_alpha__Environment.MBytes.t ->
      Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter map_to_list : forall {b c : Type}, Tezos_raw_protocol_alpha.Script_typed_ir.map
      b c -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter set_update : forall {a : Type}, a ->
      bool ->
        Tezos_raw_protocol_alpha.Script_typed_ir.set a ->
          Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
  End Legacy.
  
  Module Interpreter.
    Parameter cycle : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter loop_cycle : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter loop_size : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter loop_iter : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter loop_map : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter nop : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter stack_op : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter stack_n_op : Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter bool_binop : forall {a b : Type}, a ->
      b -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter bool_unop : forall {a : Type}, a ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter pair : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter pair_access : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter cons : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter variant_no_data : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter branch : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter concat_string : list string ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter concat_bytes : list
      Tezos_protocol_environment_alpha__Environment.MBytes.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter slice_string : Z ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter map_mem : forall {a b : Type}, a ->
      Tezos_raw_protocol_alpha.Script_typed_ir.map a b ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter map_to_list : forall {a b : Type}, Tezos_raw_protocol_alpha.Script_typed_ir.map
      a b -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter map_get : forall {a b : Type}, a ->
      Tezos_raw_protocol_alpha.Script_typed_ir.map a b ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter map_update : forall {a b : Type}, a ->
      option b ->
        Tezos_raw_protocol_alpha.Script_typed_ir.map a b ->
          Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter map_size : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter set_to_list : forall {a : Type}, Tezos_raw_protocol_alpha.Script_typed_ir.set
      a -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter set_update : forall {a : Type}, a ->
      bool ->
        Tezos_raw_protocol_alpha.Script_typed_ir.set a ->
          Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter set_mem : forall {a : Type}, a ->
      Tezos_raw_protocol_alpha.Script_typed_ir.set a ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter mul : forall {a b : Type}, Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
      a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num b ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter div : forall {a b : Type}, Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
      a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num b ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter add : forall {a b : Type}, Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
      a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num b ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter sub : forall {a b : Type}, Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
      a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num b ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter abs : forall {a : Type}, Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
      a -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter neg : forall {a : Type}, Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
      a -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter int : forall {a : Type}, a ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter add_timestamp : forall {a : Type}, Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t
      ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num a ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter sub_timestamp : forall {a : Type}, Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t
      ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num a ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter diff_timestamps : Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t
      ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter empty_set : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter set_size : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter empty_map : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter int64_op : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter z_to_int64 : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter int64_to_z : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter logor : forall {a b : Type}, Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
      a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num b ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter logand : forall {a b : Type}, Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
      a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num b ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter logxor : forall {a b : Type}, Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
      a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num b ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter lognot : forall {a : Type}, Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
      a -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter shift_left : forall {a b : Type}, Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
      a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num b ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter shift_right : forall {a b : Type}, Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
      a ->
      Tezos_raw_protocol_alpha.Alpha_context.Script_int.num b ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter exec : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter push : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter compare_res : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter unpack_failed : Tezos_protocol_environment_alpha__Environment.MBytes.t
      -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter address : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter contract : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter transfer : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter create_account : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter create_contract : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter implicit_account : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter set_delegate : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter balance : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter now : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter check_signature : Tezos_raw_protocol_alpha.Alpha_context.public_key
      ->
      Tezos_protocol_environment_alpha__Environment.MBytes.t ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter hash_key : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter hash_blake2b : Tezos_protocol_environment_alpha__Environment.MBytes.t
      -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter hash_sha256 : Tezos_protocol_environment_alpha__Environment.MBytes.t
      -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter hash_sha512 : Tezos_protocol_environment_alpha__Environment.MBytes.t
      -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter steps_to_quota : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter source : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter self : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter amount : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter chain_id : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter wrap : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter compare : forall {a : Type}, Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty
      a -> a -> a -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter apply : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
  End Interpreter.
  
  Module Typechecking.
    Parameter cycle : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter unit : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter bool : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter tez : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter z : Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter string : Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter bytes : Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter int_of_string : string ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter string_timestamp : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter key : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter key_hash : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter signature : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter chain_id : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter contract : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter get_script : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter contract_exists : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter pair : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter union : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter lambda : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter some : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter none : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter list_element : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter set_element : Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter map_element : Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter primitive_type : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter one_arg_type : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter two_arg_type : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter operation : Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter type_ : Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter instr : forall {a b : Type}, Tezos_raw_protocol_alpha.Script_typed_ir.instr
      a b -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
  End Typechecking.
  
  Module Unparse.
    Parameter prim_cost : Z ->
      Tezos_raw_protocol_alpha.Alpha_context.Script.annot ->
        Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter seq_cost : Z -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter cycle : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter unit : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter bool : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter z : Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter int : forall {a : Type}, Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
      a -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter tez : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter string : string -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter bytes : Tezos_protocol_environment_alpha__Environment.MBytes.t ->
      Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter timestamp : Tezos_raw_protocol_alpha.Alpha_context.Script_timestamp.t
      -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter key : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter key_hash : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter signature : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter operation : Tezos_protocol_environment_alpha__Environment.MBytes.t
      -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter chain_id : Tezos_protocol_environment_alpha__Environment.MBytes.t
      -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter contract : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter pair : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter union : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter some : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter none : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter list_element : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter set_element : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter map_element : Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter one_arg_type : Tezos_raw_protocol_alpha.Alpha_context.Script.annot
      -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter two_arg_type : Tezos_raw_protocol_alpha.Alpha_context.Script.annot
      -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter set_to_list : forall {a : Type}, Tezos_raw_protocol_alpha.Script_typed_ir.set
      a -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
    
    Parameter map_to_list : forall {a b : Type}, Tezos_raw_protocol_alpha.Script_typed_ir.map
      a b -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost.
  End Unparse.
End Cost_of.
michelson_v1_primitives.ml 16 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Micheline

type error += Unknown_primitive_name of string

type error += Invalid_case of string

type error +=
  | Invalid_primitive_name of
      string Micheline.canonical * Micheline.canonical_location

type prim =
  | K_parameter
  | K_storage
  | K_code
  | D_False
  | D_Elt
  | D_Left
  | D_None
  | D_Pair
  | D_Right
  | D_Some
  | D_True
  | D_Unit
  | I_PACK
  | I_UNPACK
  | I_BLAKE2B
  | I_SHA256
  | I_SHA512
  | I_ABS
  | I_ADD
  | I_AMOUNT
  | I_AND
  | I_BALANCE
  | I_CAR
  | I_CDR
  | I_CHAIN_ID
  | I_CHECK_SIGNATURE
  | I_COMPARE
  | I_CONCAT
  | I_CONS
  | I_CREATE_ACCOUNT
  | I_CREATE_CONTRACT
  | I_IMPLICIT_ACCOUNT
  | I_DIP
  | I_DROP
  | I_DUP
  | I_EDIV
  | I_EMPTY_BIG_MAP
  | I_EMPTY_MAP
  | I_EMPTY_SET
  | I_EQ
  | I_EXEC
  | I_APPLY
  | I_FAILWITH
  | I_GE
  | I_GET
  | I_GT
  | I_HASH_KEY
  | I_IF
  | I_IF_CONS
  | I_IF_LEFT
  | I_IF_NONE
  | I_INT
  | I_LAMBDA
  | I_LE
  | I_LEFT
  | I_LOOP
  | I_LSL
  | I_LSR
  | I_LT
  | I_MAP
  | I_MEM
  | I_MUL
  | I_NEG
  | I_NEQ
  | I_NIL
  | I_NONE
  | I_NOT
  | I_NOW
  | I_OR
  | I_PAIR
  | I_PUSH
  | I_RIGHT
  | I_SIZE
  | I_SOME
  | I_SOURCE
  | I_SENDER
  | I_SELF
  | I_SLICE
  | I_STEPS_TO_QUOTA
  | I_SUB
  | I_SWAP
  | I_TRANSFER_TOKENS
  | I_SET_DELEGATE
  | I_UNIT
  | I_UPDATE
  | I_XOR
  | I_ITER
  | I_LOOP_LEFT
  | I_ADDRESS
  | I_CONTRACT
  | I_ISNAT
  | I_CAST
  | I_RENAME
  | I_DIG
  | I_DUG
  | T_bool
  | T_contract
  | T_int
  | T_key
  | T_key_hash
  | T_lambda
  | T_list
  | T_map
  | T_big_map
  | T_nat
  | T_option
  | T_or
  | T_pair
  | T_set
  | T_signature
  | T_string
  | T_bytes
  | T_mutez
  | T_timestamp
  | T_unit
  | T_operation
  | T_address
  | T_chain_id

let valid_case name =
  let is_lower = function '_' | 'a' .. 'z' -> true | _ -> false in
  let is_upper = function '_' | 'A' .. 'Z' -> true | _ -> false in
  let rec for_all a b f =
    Compare.Int.(a > b) || (f a && for_all (a + 1) b f)
  in
  let len = String.length name in
  Compare.Int.(len <> 0)
  && Compare.Char.(name.[0] <> '_')
  && ( (is_upper name.[0] && for_all 1 (len - 1) (fun i -> is_upper name.[i]))
     || (is_upper name.[0] && for_all 1 (len - 1) (fun i -> is_lower name.[i]))
     || (is_lower name.[0] && for_all 1 (len - 1) (fun i -> is_lower name.[i]))
     )

let string_of_prim = function
  | K_parameter ->
      "parameter"
  | K_storage ->
      "storage"
  | K_code ->
      "code"
  | D_False ->
      "False"
  | D_Elt ->
      "Elt"
  | D_Left ->
      "Left"
  | D_None ->
      "None"
  | D_Pair ->
      "Pair"
  | D_Right ->
      "Right"
  | D_Some ->
      "Some"
  | D_True ->
      "True"
  | D_Unit ->
      "Unit"
  | I_PACK ->
      "PACK"
  | I_UNPACK ->
      "UNPACK"
  | I_BLAKE2B ->
      "BLAKE2B"
  | I_SHA256 ->
      "SHA256"
  | I_SHA512 ->
      "SHA512"
  | I_ABS ->
      "ABS"
  | I_ADD ->
      "ADD"
  | I_AMOUNT ->
      "AMOUNT"
  | I_AND ->
      "AND"
  | I_BALANCE ->
      "BALANCE"
  | I_CAR ->
      "CAR"
  | I_CDR ->
      "CDR"
  | I_CHAIN_ID ->
      "CHAIN_ID"
  | I_CHECK_SIGNATURE ->
      "CHECK_SIGNATURE"
  | I_COMPARE ->
      "COMPARE"
  | I_CONCAT ->
      "CONCAT"
  | I_CONS ->
      "CONS"
  | I_CREATE_ACCOUNT ->
      "CREATE_ACCOUNT"
  | I_CREATE_CONTRACT ->
      "CREATE_CONTRACT"
  | I_IMPLICIT_ACCOUNT ->
      "IMPLICIT_ACCOUNT"
  | I_DIP ->
      "DIP"
  | I_DROP ->
      "DROP"
  | I_DUP ->
      "DUP"
  | I_EDIV ->
      "EDIV"
  | I_EMPTY_BIG_MAP ->
      "EMPTY_BIG_MAP"
  | I_EMPTY_MAP ->
      "EMPTY_MAP"
  | I_EMPTY_SET ->
      "EMPTY_SET"
  | I_EQ ->
      "EQ"
  | I_EXEC ->
      "EXEC"
  | I_APPLY ->
      "APPLY"
  | I_FAILWITH ->
      "FAILWITH"
  | I_GE ->
      "GE"
  | I_GET ->
      "GET"
  | I_GT ->
      "GT"
  | I_HASH_KEY ->
      "HASH_KEY"
  | I_IF ->
      "IF"
  | I_IF_CONS ->
      "IF_CONS"
  | I_IF_LEFT ->
      "IF_LEFT"
  | I_IF_NONE ->
      "IF_NONE"
  | I_INT ->
      "INT"
  | I_LAMBDA ->
      "LAMBDA"
  | I_LE ->
      "LE"
  | I_LEFT ->
      "LEFT"
  | I_LOOP ->
      "LOOP"
  | I_LSL ->
      "LSL"
  | I_LSR ->
      "LSR"
  | I_LT ->
      "LT"
  | I_MAP ->
      "MAP"
  | I_MEM ->
      "MEM"
  | I_MUL ->
      "MUL"
  | I_NEG ->
      "NEG"
  | I_NEQ ->
      "NEQ"
  | I_NIL ->
      "NIL"
  | I_NONE ->
      "NONE"
  | I_NOT ->
      "NOT"
  | I_NOW ->
      "NOW"
  | I_OR ->
      "OR"
  | I_PAIR ->
      "PAIR"
  | I_PUSH ->
      "PUSH"
  | I_RIGHT ->
      "RIGHT"
  | I_SIZE ->
      "SIZE"
  | I_SOME ->
      "SOME"
  | I_SOURCE ->
      "SOURCE"
  | I_SENDER ->
      "SENDER"
  | I_SELF ->
      "SELF"
  | I_SLICE ->
      "SLICE"
  | I_STEPS_TO_QUOTA ->
      "STEPS_TO_QUOTA"
  | I_SUB ->
      "SUB"
  | I_SWAP ->
      "SWAP"
  | I_TRANSFER_TOKENS ->
      "TRANSFER_TOKENS"
  | I_SET_DELEGATE ->
      "SET_DELEGATE"
  | I_UNIT ->
      "UNIT"
  | I_UPDATE ->
      "UPDATE"
  | I_XOR ->
      "XOR"
  | I_ITER ->
      "ITER"
  | I_LOOP_LEFT ->
      "LOOP_LEFT"
  | I_ADDRESS ->
      "ADDRESS"
  | I_CONTRACT ->
      "CONTRACT"
  | I_ISNAT ->
      "ISNAT"
  | I_CAST ->
      "CAST"
  | I_RENAME ->
      "RENAME"
  | I_DIG ->
      "DIG"
  | I_DUG ->
      "DUG"
  | T_bool ->
      "bool"
  | T_contract ->
      "contract"
  | T_int ->
      "int"
  | T_key ->
      "key"
  | T_key_hash ->
      "key_hash"
  | T_lambda ->
      "lambda"
  | T_list ->
      "list"
  | T_map ->
      "map"
  | T_big_map ->
      "big_map"
  | T_nat ->
      "nat"
  | T_option ->
      "option"
  | T_or ->
      "or"
  | T_pair ->
      "pair"
  | T_set ->
      "set"
  | T_signature ->
      "signature"
  | T_string ->
      "string"
  | T_bytes ->
      "bytes"
  | T_mutez ->
      "mutez"
  | T_timestamp ->
      "timestamp"
  | T_unit ->
      "unit"
  | T_operation ->
      "operation"
  | T_address ->
      "address"
  | T_chain_id ->
      "chain_id"

let prim_of_string = function
  | "parameter" ->
      ok K_parameter
  | "storage" ->
      ok K_storage
  | "code" ->
      ok K_code
  | "False" ->
      ok D_False
  | "Elt" ->
      ok D_Elt
  | "Left" ->
      ok D_Left
  | "None" ->
      ok D_None
  | "Pair" ->
      ok D_Pair
  | "Right" ->
      ok D_Right
  | "Some" ->
      ok D_Some
  | "True" ->
      ok D_True
  | "Unit" ->
      ok D_Unit
  | "PACK" ->
      ok I_PACK
  | "UNPACK" ->
      ok I_UNPACK
  | "BLAKE2B" ->
      ok I_BLAKE2B
  | "SHA256" ->
      ok I_SHA256
  | "SHA512" ->
      ok I_SHA512
  | "ABS" ->
      ok I_ABS
  | "ADD" ->
      ok I_ADD
  | "AMOUNT" ->
      ok I_AMOUNT
  | "AND" ->
      ok I_AND
  | "BALANCE" ->
      ok I_BALANCE
  | "CAR" ->
      ok I_CAR
  | "CDR" ->
      ok I_CDR
  | "CHAIN_ID" ->
      ok I_CHAIN_ID
  | "CHECK_SIGNATURE" ->
      ok I_CHECK_SIGNATURE
  | "COMPARE" ->
      ok I_COMPARE
  | "CONCAT" ->
      ok I_CONCAT
  | "CONS" ->
      ok I_CONS
  | "CREATE_ACCOUNT" ->
      ok I_CREATE_ACCOUNT
  | "CREATE_CONTRACT" ->
      ok I_CREATE_CONTRACT
  | "IMPLICIT_ACCOUNT" ->
      ok I_IMPLICIT_ACCOUNT
  | "DIP" ->
      ok I_DIP
  | "DROP" ->
      ok I_DROP
  | "DUP" ->
      ok I_DUP
  | "EDIV" ->
      ok I_EDIV
  | "EMPTY_BIG_MAP" ->
      ok I_EMPTY_BIG_MAP
  | "EMPTY_MAP" ->
      ok I_EMPTY_MAP
  | "EMPTY_SET" ->
      ok I_EMPTY_SET
  | "EQ" ->
      ok I_EQ
  | "EXEC" ->
      ok I_EXEC
  | "APPLY" ->
      ok I_APPLY
  | "FAILWITH" ->
      ok I_FAILWITH
  | "GE" ->
      ok I_GE
  | "GET" ->
      ok I_GET
  | "GT" ->
      ok I_GT
  | "HASH_KEY" ->
      ok I_HASH_KEY
  | "IF" ->
      ok I_IF
  | "IF_CONS" ->
      ok I_IF_CONS
  | "IF_LEFT" ->
      ok I_IF_LEFT
  | "IF_NONE" ->
      ok I_IF_NONE
  | "INT" ->
      ok I_INT
  | "LAMBDA" ->
      ok I_LAMBDA
  | "LE" ->
      ok I_LE
  | "LEFT" ->
      ok I_LEFT
  | "LOOP" ->
      ok I_LOOP
  | "LSL" ->
      ok I_LSL
  | "LSR" ->
      ok I_LSR
  | "LT" ->
      ok I_LT
  | "MAP" ->
      ok I_MAP
  | "MEM" ->
      ok I_MEM
  | "MUL" ->
      ok I_MUL
  | "NEG" ->
      ok I_NEG
  | "NEQ" ->
      ok I_NEQ
  | "NIL" ->
      ok I_NIL
  | "NONE" ->
      ok I_NONE
  | "NOT" ->
      ok I_NOT
  | "NOW" ->
      ok I_NOW
  | "OR" ->
      ok I_OR
  | "PAIR" ->
      ok I_PAIR
  | "PUSH" ->
      ok I_PUSH
  | "RIGHT" ->
      ok I_RIGHT
  | "SIZE" ->
      ok I_SIZE
  | "SOME" ->
      ok I_SOME
  | "SOURCE" ->
      ok I_SOURCE
  | "SENDER" ->
      ok I_SENDER
  | "SELF" ->
      ok I_SELF
  | "SLICE" ->
      ok I_SLICE
  | "STEPS_TO_QUOTA" ->
      ok I_STEPS_TO_QUOTA
  | "SUB" ->
      ok I_SUB
  | "SWAP" ->
      ok I_SWAP
  | "TRANSFER_TOKENS" ->
      ok I_TRANSFER_TOKENS
  | "SET_DELEGATE" ->
      ok I_SET_DELEGATE
  | "UNIT" ->
      ok I_UNIT
  | "UPDATE" ->
      ok I_UPDATE
  | "XOR" ->
      ok I_XOR
  | "ITER" ->
      ok I_ITER
  | "LOOP_LEFT" ->
      ok I_LOOP_LEFT
  | "ADDRESS" ->
      ok I_ADDRESS
  | "CONTRACT" ->
      ok I_CONTRACT
  | "ISNAT" ->
      ok I_ISNAT
  | "CAST" ->
      ok I_CAST
  | "RENAME" ->
      ok I_RENAME
  | "DIG" ->
      ok I_DIG
  | "DUG" ->
      ok I_DUG
  | "bool" ->
      ok T_bool
  | "contract" ->
      ok T_contract
  | "int" ->
      ok T_int
  | "key" ->
      ok T_key
  | "key_hash" ->
      ok T_key_hash
  | "lambda" ->
      ok T_lambda
  | "list" ->
      ok T_list
  | "map" ->
      ok T_map
  | "big_map" ->
      ok T_big_map
  | "nat" ->
      ok T_nat
  | "option" ->
      ok T_option
  | "or" ->
      ok T_or
  | "pair" ->
      ok T_pair
  | "set" ->
      ok T_set
  | "signature" ->
      ok T_signature
  | "string" ->
      ok T_string
  | "bytes" ->
      ok T_bytes
  | "mutez" ->
      ok T_mutez
  | "timestamp" ->
      ok T_timestamp
  | "unit" ->
      ok T_unit
  | "operation" ->
      ok T_operation
  | "address" ->
      ok T_address
  | "chain_id" ->
      ok T_chain_id
  | n ->
      if valid_case n then error (Unknown_primitive_name n)
      else error (Invalid_case n)

let prims_of_strings expr =
  let rec convert = function
    | (Int _ | String _ | Bytes _) as expr ->
        ok expr
    | Prim (loc, prim, args, annot) ->
        Error_monad.record_trace
          (Invalid_primitive_name (expr, loc))
          (prim_of_string prim)
        >>? fun prim ->
        List.fold_left
          (fun acc arg ->
            acc >>? fun args -> convert arg >>? fun arg -> ok (arg :: args))
          (ok [])
          args
        >>? fun args -> ok (Prim (0, prim, List.rev args, annot))
    | Seq (_, args) ->
        List.fold_left
          (fun acc arg ->
            acc >>? fun args -> convert arg >>? fun arg -> ok (arg :: args))
          (ok [])
          args
        >>? fun args -> ok (Seq (0, List.rev args))
  in
  convert (root expr) >>? fun expr -> ok (strip_locations expr)

let strings_of_prims expr =
  let rec convert = function
    | (Int _ | String _ | Bytes _) as expr ->
        expr
    | Prim (_, prim, args, annot) ->
        let prim = string_of_prim prim in
        let args = List.map convert args in
        Prim (0, prim, args, annot)
    | Seq (_, args) ->
        let args = List.map convert args in
        Seq (0, args)
  in
  strip_locations (convert (root expr))

let prim_encoding =
  let open Data_encoding in
  def "michelson.v1.primitives"
  @@ string_enum
       [ (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("parameter", K_parameter);
         ("storage", K_storage);
         ("code", K_code);
         ("False", D_False);
         ("Elt", D_Elt);
         ("Left", D_Left);
         ("None", D_None);
         ("Pair", D_Pair);
         ("Right", D_Right);
         ("Some", D_Some);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("True", D_True);
         ("Unit", D_Unit);
         ("PACK", I_PACK);
         ("UNPACK", I_UNPACK);
         ("BLAKE2B", I_BLAKE2B);
         ("SHA256", I_SHA256);
         ("SHA512", I_SHA512);
         ("ABS", I_ABS);
         ("ADD", I_ADD);
         ("AMOUNT", I_AMOUNT);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("AND", I_AND);
         ("BALANCE", I_BALANCE);
         ("CAR", I_CAR);
         ("CDR", I_CDR);
         ("CHECK_SIGNATURE", I_CHECK_SIGNATURE);
         ("COMPARE", I_COMPARE);
         ("CONCAT", I_CONCAT);
         ("CONS", I_CONS);
         ("CREATE_ACCOUNT", I_CREATE_ACCOUNT);
         ("CREATE_CONTRACT", I_CREATE_CONTRACT);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("IMPLICIT_ACCOUNT", I_IMPLICIT_ACCOUNT);
         ("DIP", I_DIP);
         ("DROP", I_DROP);
         ("DUP", I_DUP);
         ("EDIV", I_EDIV);
         ("EMPTY_MAP", I_EMPTY_MAP);
         ("EMPTY_SET", I_EMPTY_SET);
         ("EQ", I_EQ);
         ("EXEC", I_EXEC);
         ("FAILWITH", I_FAILWITH);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("GE", I_GE);
         ("GET", I_GET);
         ("GT", I_GT);
         ("HASH_KEY", I_HASH_KEY);
         ("IF", I_IF);
         ("IF_CONS", I_IF_CONS);
         ("IF_LEFT", I_IF_LEFT);
         ("IF_NONE", I_IF_NONE);
         ("INT", I_INT);
         ("LAMBDA", I_LAMBDA);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("LE", I_LE);
         ("LEFT", I_LEFT);
         ("LOOP", I_LOOP);
         ("LSL", I_LSL);
         ("LSR", I_LSR);
         ("LT", I_LT);
         ("MAP", I_MAP);
         ("MEM", I_MEM);
         ("MUL", I_MUL);
         ("NEG", I_NEG);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("NEQ", I_NEQ);
         ("NIL", I_NIL);
         ("NONE", I_NONE);
         ("NOT", I_NOT);
         ("NOW", I_NOW);
         ("OR", I_OR);
         ("PAIR", I_PAIR);
         ("PUSH", I_PUSH);
         ("RIGHT", I_RIGHT);
         ("SIZE", I_SIZE);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("SOME", I_SOME);
         ("SOURCE", I_SOURCE);
         ("SENDER", I_SENDER);
         ("SELF", I_SELF);
         ("STEPS_TO_QUOTA", I_STEPS_TO_QUOTA);
         ("SUB", I_SUB);
         ("SWAP", I_SWAP);
         ("TRANSFER_TOKENS", I_TRANSFER_TOKENS);
         ("SET_DELEGATE", I_SET_DELEGATE);
         ("UNIT", I_UNIT);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("UPDATE", I_UPDATE);
         ("XOR", I_XOR);
         ("ITER", I_ITER);
         ("LOOP_LEFT", I_LOOP_LEFT);
         ("ADDRESS", I_ADDRESS);
         ("CONTRACT", I_CONTRACT);
         ("ISNAT", I_ISNAT);
         ("CAST", I_CAST);
         ("RENAME", I_RENAME);
         ("bool", T_bool);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("contract", T_contract);
         ("int", T_int);
         ("key", T_key);
         ("key_hash", T_key_hash);
         ("lambda", T_lambda);
         ("list", T_list);
         ("map", T_map);
         ("big_map", T_big_map);
         ("nat", T_nat);
         ("option", T_option);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("or", T_or);
         ("pair", T_pair);
         ("set", T_set);
         ("signature", T_signature);
         ("string", T_string);
         ("bytes", T_bytes);
         ("mutez", T_mutez);
         ("timestamp", T_timestamp);
         ("unit", T_unit);
         ("operation", T_operation);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("address", T_address);
         (* Alpha_002 addition *)
         ("SLICE", I_SLICE);
         (* Alpha_005 addition *)
         ("DIG", I_DIG);
         ("DUG", I_DUG);
         ("EMPTY_BIG_MAP", I_EMPTY_BIG_MAP);
         ("APPLY", I_APPLY);
         ("chain_id", T_chain_id);
         ("CHAIN_ID", I_CHAIN_ID)
         (* New instructions must be added here, for backward compatibility of the encoding. *)
        ]

let () =
  register_error_kind
    `Permanent
    ~id:"michelson_v1.unknown_primitive_name"
    ~title:"Unknown primitive name"
    ~description:"In a script or data expression, a primitive was unknown."
    ~pp:(fun ppf n -> Format.fprintf ppf "Unknown primitive %s." n)
    Data_encoding.(obj1 (req "wrong_primitive_name" string))
    (function Unknown_primitive_name got -> Some got | _ -> None)
    (fun got -> Unknown_primitive_name got) ;
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_primitive_name_case"
    ~title:"Invalid primitive name case"
    ~description:
      "In a script or data expression, a primitive name is neither uppercase, \
       lowercase or capitalized."
    ~pp:(fun ppf n -> Format.fprintf ppf "Primitive %s has invalid case." n)
    Data_encoding.(obj1 (req "wrong_primitive_name" string))
    (function Invalid_case name -> Some name | _ -> None)
    (fun name -> Invalid_case name) ;
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_primitive_name"
    ~title:"Invalid primitive name"
    ~description:
      "In a script or data expression, a primitive name is unknown or has a \
       wrong case."
    ~pp:(fun ppf _ -> Format.fprintf ppf "Invalid primitive.")
    Data_encoding.(
      obj2
        (req
           "expression"
           (Micheline.canonical_encoding ~variant:"generic" string))
        (req "location" Micheline.canonical_location_encoding))
    (function
      | Invalid_primitive_name (expr, loc) -> Some (expr, loc) | _ -> None)
    (fun (expr, loc) -> Invalid_primitive_name (expr, loc))
michelson_v1_primitives_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Micheline.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

Inductive prim : Type :=
| K_parameter : prim
| K_storage : prim
| K_code : prim
| D_False : prim
| D_Elt : prim
| D_Left : prim
| D_None : prim
| D_Pair : prim
| D_Right : prim
| D_Some : prim
| D_True : prim
| D_Unit : prim
| I_PACK : prim
| I_UNPACK : prim
| I_BLAKE2B : prim
| I_SHA256 : prim
| I_SHA512 : prim
| I_ABS : prim
| I_ADD : prim
| I_AMOUNT : prim
| I_AND : prim
| I_BALANCE : prim
| I_CAR : prim
| I_CDR : prim
| I_CHAIN_ID : prim
| I_CHECK_SIGNATURE : prim
| I_COMPARE : prim
| I_CONCAT : prim
| I_CONS : prim
| I_CREATE_ACCOUNT : prim
| I_CREATE_CONTRACT : prim
| I_IMPLICIT_ACCOUNT : prim
| I_DIP : prim
| I_DROP : prim
| I_DUP : prim
| I_EDIV : prim
| I_EMPTY_BIG_MAP : prim
| I_EMPTY_MAP : prim
| I_EMPTY_SET : prim
| I_EQ : prim
| I_EXEC : prim
| I_APPLY : prim
| I_FAILWITH : prim
| I_GE : prim
| I_GET : prim
| I_GT : prim
| I_HASH_KEY : prim
| I_IF : prim
| I_IF_CONS : prim
| I_IF_LEFT : prim
| I_IF_NONE : prim
| I_INT : prim
| I_LAMBDA : prim
| I_LE : prim
| I_LEFT : prim
| I_LOOP : prim
| I_LSL : prim
| I_LSR : prim
| I_LT : prim
| I_MAP : prim
| I_MEM : prim
| I_MUL : prim
| I_NEG : prim
| I_NEQ : prim
| I_NIL : prim
| I_NONE : prim
| I_NOT : prim
| I_NOW : prim
| I_OR : prim
| I_PAIR : prim
| I_PUSH : prim
| I_RIGHT : prim
| I_SIZE : prim
| I_SOME : prim
| I_SOURCE : prim
| I_SENDER : prim
| I_SELF : prim
| I_SLICE : prim
| I_STEPS_TO_QUOTA : prim
| I_SUB : prim
| I_SWAP : prim
| I_TRANSFER_TOKENS : prim
| I_SET_DELEGATE : prim
| I_UNIT : prim
| I_UPDATE : prim
| I_XOR : prim
| I_ITER : prim
| I_LOOP_LEFT : prim
| I_ADDRESS : prim
| I_CONTRACT : prim
| I_ISNAT : prim
| I_CAST : prim
| I_RENAME : prim
| I_DIG : prim
| I_DUG : prim
| T_bool : prim
| T_contract : prim
| T_int : prim
| T_key : prim
| T_key_hash : prim
| T_lambda : prim
| T_list : prim
| T_map : prim
| T_big_map : prim
| T_nat : prim
| T_option : prim
| T_or : prim
| T_pair : prim
| T_set : prim
| T_signature : prim
| T_string : prim
| T_bytes : prim
| T_mutez : prim
| T_timestamp : prim
| T_unit : prim
| T_operation : prim
| T_address : prim
| T_chain_id : prim.

Definition valid_case (name : string) : bool :=
  let is_lower (function_parameter : ascii) : bool :=
    match function_parameter with
    |
      "_" % char |
        "a" % char |
          "b" % char |
            "c" % char |
              "d" % char |
                "e" % char |
                  "f" % char |
                    "g" % char |
                      "h" % char |
                        "i" % char |
                          "j" % char |
                            "k" % char |
                              "l" % char |
                                "m" % char |
                                  "n" % char |
                                    "o" % char |
                                      "p" % char |
                                        "q" % char |
                                          "r" % char |
                                            "s" % char |
                                              "t" % char |
                                                "u" % char |
                                                  "v" % char |
                                                    "w" % char |
                                                      "x" % char |
                                                        "y" % char | "z" % char
      => true
    | _ => false
    end in
  let is_upper (function_parameter : ascii) : bool :=
    match function_parameter with
    |
      "_" % char |
        "A" % char |
          "B" % char |
            "C" % char |
              "D" % char |
                "E" % char |
                  "F" % char |
                    "G" % char |
                      "H" % char |
                        "I" % char |
                          "J" % char |
                            "K" % char |
                              "L" % char |
                                "M" % char |
                                  "N" % char |
                                    "O" % char |
                                      "P" % char |
                                        "Q" % char |
                                          "R" % char |
                                            "S" % char |
                                              "T" % char |
                                                "U" % char |
                                                  "V" % char |
                                                    "W" % char |
                                                      "X" % char |
                                                        "Y" % char | "Z" % char
      => true
    | _ => false
    end in
  let fix for_all
    (a :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
    (b :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
    (f :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t)
      -> bool) : bool :=
    op_pipepipe
      (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
        a b) (op_andand (f a) (for_all (op_plus a 1) b f)) in
  let len := String.length name in
  op_andand
    (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_ltgt)
      len 0)
    (op_andand
      (Tezos_protocol_environment_alpha__Environment.Compare.Char.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_ltgt)
        (String.get name 0) "_" % char)
      (op_pipepipe
        (op_andand (is_upper (String.get name 0))
          (for_all 1 (op_minus len 1) (fun i => is_upper (String.get name i))))
        (op_pipepipe
          (op_andand (is_upper (String.get name 0))
            (for_all 1 (op_minus len 1) (fun i => is_lower (String.get name i))))
          (op_andand (is_lower (String.get name 0))
            (for_all 1 (op_minus len 1) (fun i => is_lower (String.get name i))))))).

Definition string_of_prim (function_parameter : prim) : string :=
  match function_parameter with
  | K_parameter => "parameter" % string
  | K_storage => "storage" % string
  | K_code => "code" % string
  | D_False => "False" % string
  | D_Elt => "Elt" % string
  | D_Left => "Left" % string
  | D_None => "None" % string
  | D_Pair => "Pair" % string
  | D_Right => "Right" % string
  | D_Some => "Some" % string
  | D_True => "True" % string
  | D_Unit => "Unit" % string
  | I_PACK => "PACK" % string
  | I_UNPACK => "UNPACK" % string
  | I_BLAKE2B => "BLAKE2B" % string
  | I_SHA256 => "SHA256" % string
  | I_SHA512 => "SHA512" % string
  | I_ABS => "ABS" % string
  | I_ADD => "ADD" % string
  | I_AMOUNT => "AMOUNT" % string
  | I_AND => "AND" % string
  | I_BALANCE => "BALANCE" % string
  | I_CAR => "CAR" % string
  | I_CDR => "CDR" % string
  | I_CHAIN_ID => "CHAIN_ID" % string
  | I_CHECK_SIGNATURE => "CHECK_SIGNATURE" % string
  | I_COMPARE => "COMPARE" % string
  | I_CONCAT => "CONCAT" % string
  | I_CONS => "CONS" % string
  | I_CREATE_ACCOUNT => "CREATE_ACCOUNT" % string
  | I_CREATE_CONTRACT => "CREATE_CONTRACT" % string
  | I_IMPLICIT_ACCOUNT => "IMPLICIT_ACCOUNT" % string
  | I_DIP => "DIP" % string
  | I_DROP => "DROP" % string
  | I_DUP => "DUP" % string
  | I_EDIV => "EDIV" % string
  | I_EMPTY_BIG_MAP => "EMPTY_BIG_MAP" % string
  | I_EMPTY_MAP => "EMPTY_MAP" % string
  | I_EMPTY_SET => "EMPTY_SET" % string
  | I_EQ => "EQ" % string
  | I_EXEC => "EXEC" % string
  | I_APPLY => "APPLY" % string
  | I_FAILWITH => "FAILWITH" % string
  | I_GE => "GE" % string
  | I_GET => "GET" % string
  | I_GT => "GT" % string
  | I_HASH_KEY => "HASH_KEY" % string
  | I_IF => "IF" % string
  | I_IF_CONS => "IF_CONS" % string
  | I_IF_LEFT => "IF_LEFT" % string
  | I_IF_NONE => "IF_NONE" % string
  | I_INT => "INT" % string
  | I_LAMBDA => "LAMBDA" % string
  | I_LE => "LE" % string
  | I_LEFT => "LEFT" % string
  | I_LOOP => "LOOP" % string
  | I_LSL => "LSL" % string
  | I_LSR => "LSR" % string
  | I_LT => "LT" % string
  | I_MAP => "MAP" % string
  | I_MEM => "MEM" % string
  | I_MUL => "MUL" % string
  | I_NEG => "NEG" % string
  | I_NEQ => "NEQ" % string
  | I_NIL => "NIL" % string
  | I_NONE => "NONE" % string
  | I_NOT => "NOT" % string
  | I_NOW => "NOW" % string
  | I_OR => "OR" % string
  | I_PAIR => "PAIR" % string
  | I_PUSH => "PUSH" % string
  | I_RIGHT => "RIGHT" % string
  | I_SIZE => "SIZE" % string
  | I_SOME => "SOME" % string
  | I_SOURCE => "SOURCE" % string
  | I_SENDER => "SENDER" % string
  | I_SELF => "SELF" % string
  | I_SLICE => "SLICE" % string
  | I_STEPS_TO_QUOTA => "STEPS_TO_QUOTA" % string
  | I_SUB => "SUB" % string
  | I_SWAP => "SWAP" % string
  | I_TRANSFER_TOKENS => "TRANSFER_TOKENS" % string
  | I_SET_DELEGATE => "SET_DELEGATE" % string
  | I_UNIT => "UNIT" % string
  | I_UPDATE => "UPDATE" % string
  | I_XOR => "XOR" % string
  | I_ITER => "ITER" % string
  | I_LOOP_LEFT => "LOOP_LEFT" % string
  | I_ADDRESS => "ADDRESS" % string
  | I_CONTRACT => "CONTRACT" % string
  | I_ISNAT => "ISNAT" % string
  | I_CAST => "CAST" % string
  | I_RENAME => "RENAME" % string
  | I_DIG => "DIG" % string
  | I_DUG => "DUG" % string
  | T_bool => "bool" % string
  | T_contract => "contract" % string
  | T_int => "int" % string
  | T_key => "key" % string
  | T_key_hash => "key_hash" % string
  | T_lambda => "lambda" % string
  | T_list => "list" % string
  | T_map => "map" % string
  | T_big_map => "big_map" % string
  | T_nat => "nat" % string
  | T_option => "option" % string
  | T_or => "or" % string
  | T_pair => "pair" % string
  | T_set => "set" % string
  | T_signature => "signature" % string
  | T_string => "string" % string
  | T_bytes => "bytes" % string
  | T_mutez => "mutez" % string
  | T_timestamp => "timestamp" % string
  | T_unit => "unit" % string
  | T_operation => "operation" % string
  | T_address => "address" % string
  | T_chain_id => "chain_id" % string
  end.

Definition prim_of_string (function_parameter : string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult prim :=
  match function_parameter with
  | "parameter" % string => ok K_parameter
  | "storage" % string => ok K_storage
  | "code" % string => ok K_code
  | "False" % string => ok D_False
  | "Elt" % string => ok D_Elt
  | "Left" % string => ok D_Left
  | "None" % string => ok D_None
  | "Pair" % string => ok D_Pair
  | "Right" % string => ok D_Right
  | "Some" % string => ok D_Some
  | "True" % string => ok D_True
  | "Unit" % string => ok D_Unit
  | "PACK" % string => ok I_PACK
  | "UNPACK" % string => ok I_UNPACK
  | "BLAKE2B" % string => ok I_BLAKE2B
  | "SHA256" % string => ok I_SHA256
  | "SHA512" % string => ok I_SHA512
  | "ABS" % string => ok I_ABS
  | "ADD" % string => ok I_ADD
  | "AMOUNT" % string => ok I_AMOUNT
  | "AND" % string => ok I_AND
  | "BALANCE" % string => ok I_BALANCE
  | "CAR" % string => ok I_CAR
  | "CDR" % string => ok I_CDR
  | "CHAIN_ID" % string => ok I_CHAIN_ID
  | "CHECK_SIGNATURE" % string => ok I_CHECK_SIGNATURE
  | "COMPARE" % string => ok I_COMPARE
  | "CONCAT" % string => ok I_CONCAT
  | "CONS" % string => ok I_CONS
  | "CREATE_ACCOUNT" % string => ok I_CREATE_ACCOUNT
  | "CREATE_CONTRACT" % string => ok I_CREATE_CONTRACT
  | "IMPLICIT_ACCOUNT" % string => ok I_IMPLICIT_ACCOUNT
  | "DIP" % string => ok I_DIP
  | "DROP" % string => ok I_DROP
  | "DUP" % string => ok I_DUP
  | "EDIV" % string => ok I_EDIV
  | "EMPTY_BIG_MAP" % string => ok I_EMPTY_BIG_MAP
  | "EMPTY_MAP" % string => ok I_EMPTY_MAP
  | "EMPTY_SET" % string => ok I_EMPTY_SET
  | "EQ" % string => ok I_EQ
  | "EXEC" % string => ok I_EXEC
  | "APPLY" % string => ok I_APPLY
  | "FAILWITH" % string => ok I_FAILWITH
  | "GE" % string => ok I_GE
  | "GET" % string => ok I_GET
  | "GT" % string => ok I_GT
  | "HASH_KEY" % string => ok I_HASH_KEY
  | "IF" % string => ok I_IF
  | "IF_CONS" % string => ok I_IF_CONS
  | "IF_LEFT" % string => ok I_IF_LEFT
  | "IF_NONE" % string => ok I_IF_NONE
  | "INT" % string => ok I_INT
  | "LAMBDA" % string => ok I_LAMBDA
  | "LE" % string => ok I_LE
  | "LEFT" % string => ok I_LEFT
  | "LOOP" % string => ok I_LOOP
  | "LSL" % string => ok I_LSL
  | "LSR" % string => ok I_LSR
  | "LT" % string => ok I_LT
  | "MAP" % string => ok I_MAP
  | "MEM" % string => ok I_MEM
  | "MUL" % string => ok I_MUL
  | "NEG" % string => ok I_NEG
  | "NEQ" % string => ok I_NEQ
  | "NIL" % string => ok I_NIL
  | "NONE" % string => ok I_NONE
  | "NOT" % string => ok I_NOT
  | "NOW" % string => ok I_NOW
  | "OR" % string => ok I_OR
  | "PAIR" % string => ok I_PAIR
  | "PUSH" % string => ok I_PUSH
  | "RIGHT" % string => ok I_RIGHT
  | "SIZE" % string => ok I_SIZE
  | "SOME" % string => ok I_SOME
  | "SOURCE" % string => ok I_SOURCE
  | "SENDER" % string => ok I_SENDER
  | "SELF" % string => ok I_SELF
  | "SLICE" % string => ok I_SLICE
  | "STEPS_TO_QUOTA" % string => ok I_STEPS_TO_QUOTA
  | "SUB" % string => ok I_SUB
  | "SWAP" % string => ok I_SWAP
  | "TRANSFER_TOKENS" % string => ok I_TRANSFER_TOKENS
  | "SET_DELEGATE" % string => ok I_SET_DELEGATE
  | "UNIT" % string => ok I_UNIT
  | "UPDATE" % string => ok I_UPDATE
  | "XOR" % string => ok I_XOR
  | "ITER" % string => ok I_ITER
  | "LOOP_LEFT" % string => ok I_LOOP_LEFT
  | "ADDRESS" % string => ok I_ADDRESS
  | "CONTRACT" % string => ok I_CONTRACT
  | "ISNAT" % string => ok I_ISNAT
  | "CAST" % string => ok I_CAST
  | "RENAME" % string => ok I_RENAME
  | "DIG" % string => ok I_DIG
  | "DUG" % string => ok I_DUG
  | "bool" % string => ok T_bool
  | "contract" % string => ok T_contract
  | "int" % string => ok T_int
  | "key" % string => ok T_key
  | "key_hash" % string => ok T_key_hash
  | "lambda" % string => ok T_lambda
  | "list" % string => ok T_list
  | "map" % string => ok T_map
  | "big_map" % string => ok T_big_map
  | "nat" % string => ok T_nat
  | "option" % string => ok T_option
  | "or" % string => ok T_or
  | "pair" % string => ok T_pair
  | "set" % string => ok T_set
  | "signature" % string => ok T_signature
  | "string" % string => ok T_string
  | "bytes" % string => ok T_bytes
  | "mutez" % string => ok T_mutez
  | "timestamp" % string => ok T_timestamp
  | "unit" % string => ok T_unit
  | "operation" % string => ok T_operation
  | "address" % string => ok T_address
  | "chain_id" % string => ok T_chain_id
  | n =>
    if valid_case n then
      error
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Unknown_primitive_name
          n)
    else
      error
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_case
          n)
  end.

Definition prims_of_strings
  (expr :
    Tezos_protocol_environment_alpha__Environment.Micheline.canonical string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_protocol_environment_alpha__Environment.Micheline.canonical prim) :=
  let fix convert
    (function_parameter :
    Tezos_protocol_environment_alpha__Environment.Micheline.node
      Tezos_protocol_environment_alpha__Environment.Micheline.canonical_location
      string)
    : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.Micheline.node
        Tezos_protocol_environment_alpha__Environment.Micheline.canonical_location
        prim) :=
    match function_parameter with
    |
      (Tezos_protocol_environment_alpha__Environment.Micheline.Int _ _ |
        Tezos_protocol_environment_alpha__Environment.Micheline.String _ _ |
        Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ _) as
        expr => ok expr
    |
      Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc prim args
        annot =>
      op_gtgtquestion
        (Error_monad.record_trace
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_primitive_name
            expr loc) (prim_of_string prim))
        (fun prim =>
          op_gtgtquestion
            (List.fold_left
              (fun acc =>
                fun arg =>
                  op_gtgtquestion acc
                    (fun args =>
                      op_gtgtquestion (convert arg)
                        (fun arg => ok (cons arg args)))) (ok []) args)
            (fun args =>
              ok
                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
                  prim (List.rev args) annot)))
    | Tezos_protocol_environment_alpha__Environment.Micheline.Seq _ args =>
      op_gtgtquestion
        (List.fold_left
          (fun acc =>
            fun arg =>
              op_gtgtquestion acc
                (fun args =>
                  op_gtgtquestion (convert arg) (fun arg => ok (cons arg args))))
          (ok []) args)
        (fun args =>
          ok
            (Tezos_protocol_environment_alpha__Environment.Micheline.Seq 0
              (List.rev args)))
    end in
  op_gtgtquestion (convert (root expr)) (fun expr => ok (strip_locations expr)).

Definition strings_of_prims
  (expr : Tezos_protocol_environment_alpha__Environment.Micheline.canonical prim)
  : Tezos_protocol_environment_alpha__Environment.Micheline.canonical string :=
  let fix convert
    (function_parameter :
    Tezos_protocol_environment_alpha__Environment.Micheline.node Z prim)
    : Tezos_protocol_environment_alpha__Environment.Micheline.node Z string :=
    match function_parameter with
    |
      (Tezos_protocol_environment_alpha__Environment.Micheline.Int _ _ |
        Tezos_protocol_environment_alpha__Environment.Micheline.String _ _ |
        Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ _) as
        expr => expr
    |
      Tezos_protocol_environment_alpha__Environment.Micheline.Prim _ prim args
        annot =>
      let prim := string_of_prim prim in
      let args := List.map convert args in
      Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0 prim args
        annot
    | Tezos_protocol_environment_alpha__Environment.Micheline.Seq _ args =>
      let args := List.map convert args in
      Tezos_protocol_environment_alpha__Environment.Micheline.Seq 0 args
    end in
  strip_locations (convert (root expr)).

Definition prim_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding prim :=
  op_atat
    (let arg := def "michelson.v1.primitives" % string in
    fun eta => arg None None eta)
    (string_enum
      (cons ("parameter" % string, K_parameter)
        (cons ("storage" % string, K_storage)
          (cons ("code" % string, K_code)
            (cons ("False" % string, D_False)
              (cons ("Elt" % string, D_Elt)
                (cons ("Left" % string, D_Left)
                  (cons ("None" % string, D_None)
                    (cons ("Pair" % string, D_Pair)
                      (cons ("Right" % string, D_Right)
                        (cons ("Some" % string, D_Some)
                          (cons ("True" % string, D_True)
                            (cons ("Unit" % string, D_Unit)
                              (cons ("PACK" % string, I_PACK)
                                (cons ("UNPACK" % string, I_UNPACK)
                                  (cons ("BLAKE2B" % string, I_BLAKE2B)
                                    (cons ("SHA256" % string, I_SHA256)
                                      (cons ("SHA512" % string, I_SHA512)
                                        (cons ("ABS" % string, I_ABS)
                                          (cons ("ADD" % string, I_ADD)
                                            (cons ("AMOUNT" % string, I_AMOUNT)
                                              (cons ("AND" % string, I_AND)
                                                (cons
                                                  ("BALANCE" % string, I_BALANCE)
                                                  (cons ("CAR" % string, I_CAR)
                                                    (cons
                                                      ("CDR" % string, I_CDR)
                                                      (cons
                                                        ("CHECK_SIGNATURE" %
                                                          string,
                                                          I_CHECK_SIGNATURE)
                                                        (cons
                                                          ("COMPARE" % string,
                                                            I_COMPARE)
                                                          (cons
                                                            ("CONCAT" % string,
                                                              I_CONCAT)
                                                            (cons
                                                              ("CONS" % string,
                                                                I_CONS)
                                                              (cons
                                                                ("CREATE_ACCOUNT"
                                                                  % string,
                                                                  I_CREATE_ACCOUNT)
                                                                (cons
                                                                  ("CREATE_CONTRACT"
                                                                    % string,
                                                                    I_CREATE_CONTRACT)
                                                                  (cons
                                                                    ("IMPLICIT_ACCOUNT"
                                                                      % string,
                                                                      I_IMPLICIT_ACCOUNT)
                                                                    (cons
                                                                      ("DIP" %
                                                                        string,
                                                                        I_DIP)
                                                                      (cons
                                                                        ("DROP"
                                                                          %
                                                                          string,
                                                                          I_DROP)
                                                                        (cons
                                                                          ("DUP"
                                                                            %
                                                                            string,
                                                                            I_DUP)
                                                                          (cons
                                                                            ("EDIV"
                                                                              %
                                                                              string,
                                                                              I_EDIV)
                                                                            (cons
                                                                              ("EMPTY_MAP"
                                                                                %
                                                                                string,
                                                                                I_EMPTY_MAP)
                                                                              (cons
                                                                                ("EMPTY_SET"
                                                                                  %
                                                                                  string,
                                                                                  I_EMPTY_SET)
                                                                                (cons
                                                                                  ("EQ"
                                                                                    %
                                                                                    string,
                                                                                    I_EQ)
                                                                                  (cons
                                                                                    ("EXEC"
                                                                                      %
                                                                                      string,
                                                                                      I_EXEC)
                                                                                    (cons
                                                                                      ("FAILWITH"
                                                                                        %
                                                                                        string,
                                                                                        I_FAILWITH)
                                                                                      (cons
                                                                                        ("GE"
                                                                                          %
                                                                                          string,
                                                                                          I_GE)
                                                                                        (cons
                                                                                          ("GET"
                                                                                            %
                                                                                            string,
                                                                                            I_GET)
                                                                                          (cons
                                                                                            ("GT"
                                                                                              %
                                                                                              string,
                                                                                              I_GT)
                                                                                            (cons
                                                                                              ("HASH_KEY"
                                                                                                %
                                                                                                string,
                                                                                                I_HASH_KEY)
                                                                                              (cons
                                                                                                ("IF"
                                                                                                  %
                                                                                                  string,
                                                                                                  I_IF)
                                                                                                (cons
                                                                                                  ("IF_CONS"
                                                                                                    %
                                                                                                    string,
                                                                                                    I_IF_CONS)
                                                                                                  (cons
                                                                                                    ("IF_LEFT"
                                                                                                      %
                                                                                                      string,
                                                                                                      I_IF_LEFT)
                                                                                                    (cons
                                                                                                      ("IF_NONE"
                                                                                                        %
                                                                                                        string,
                                                                                                        I_IF_NONE)
                                                                                                      (cons
                                                                                                        ("INT"
                                                                                                          %
                                                                                                          string,
                                                                                                          I_INT)
                                                                                                        (cons
                                                                                                          ("LAMBDA"
                                                                                                            %
                                                                                                            string,
                                                                                                            I_LAMBDA)
                                                                                                          (cons
                                                                                                            ("LE"
                                                                                                              %
                                                                                                              string,
                                                                                                              I_LE)
                                                                                                            (cons
                                                                                                              ("LEFT"
                                                                                                                %
                                                                                                                string,
                                                                                                                I_LEFT)
                                                                                                              (cons
                                                                                                                ("LOOP"
                                                                                                                  %
                                                                                                                  string,
                                                                                                                  I_LOOP)
                                                                                                                (cons
                                                                                                                  ("LSL"
                                                                                                                    %
                                                                                                                    string,
                                                                                                                    I_LSL)
                                                                                                                  (cons
                                                                                                                    ("LSR"
                                                                                                                      %
                                                                                                                      string,
                                                                                                                      I_LSR)
                                                                                                                    (cons
                                                                                                                      ("LT"
                                                                                                                        %
                                                                                                                        string,
                                                                                                                        I_LT)
                                                                                                                      (cons
                                                                                                                        ("MAP"
                                                                                                                          %
                                                                                                                          string,
                                                                                                                          I_MAP)
                                                                                                                        (cons
                                                                                                                          ("MEM"
                                                                                                                            %
                                                                                                                            string,
                                                                                                                            I_MEM)
                                                                                                                          (cons
                                                                                                                            ("MUL"
                                                                                                                              %
                                                                                                                              string,
                                                                                                                              I_MUL)
                                                                                                                            (cons
                                                                                                                              ("NEG"
                                                                                                                                %
                                                                                                                                string,
                                                                                                                                I_NEG)
                                                                                                                              (cons
                                                                                                                                ("NEQ"
                                                                                                                                  %
                                                                                                                                  string,
                                                                                                                                  I_NEQ)
                                                                                                                                (cons
                                                                                                                                  ("NIL"
                                                                                                                                    %
                                                                                                                                    string,
                                                                                                                                    I_NIL)
                                                                                                                                  (cons
                                                                                                                                    ("NONE"
                                                                                                                                      %
                                                                                                                                      string,
                                                                                                                                      I_NONE)
                                                                                                                                    (cons
                                                                                                                                      ("NOT"
                                                                                                                                        %
                                                                                                                                        string,
                                                                                                                                        I_NOT)
                                                                                                                                      (cons
                                                                                                                                        ("NOW"
                                                                                                                                          %
                                                                                                                                          string,
                                                                                                                                          I_NOW)
                                                                                                                                        (cons
                                                                                                                                          ("OR"
                                                                                                                                            %
                                                                                                                                            string,
                                                                                                                                            I_OR)
                                                                                                                                          (cons
                                                                                                                                            ("PAIR"
                                                                                                                                              %
                                                                                                                                              string,
                                                                                                                                              I_PAIR)
                                                                                                                                            (cons
                                                                                                                                              ("PUSH"
                                                                                                                                                %
                                                                                                                                                string,
                                                                                                                                                I_PUSH)
                                                                                                                                              (cons
                                                                                                                                                ("RIGHT"
                                                                                                                                                  %
                                                                                                                                                  string,
                                                                                                                                                  I_RIGHT)
                                                                                                                                                (cons
                                                                                                                                                  ("SIZE"
                                                                                                                                                    %
                                                                                                                                                    string,
                                                                                                                                                    I_SIZE)
                                                                                                                                                  (cons
                                                                                                                                                    ("SOME"
                                                                                                                                                      %
                                                                                                                                                      string,
                                                                                                                                                      I_SOME)
                                                                                                                                                    (cons
                                                                                                                                                      ("SOURCE"
                                                                                                                                                        %
                                                                                                                                                        string,
                                                                                                                                                        I_SOURCE)
                                                                                                                                                      (cons
                                                                                                                                                        ("SENDER"
                                                                                                                                                          %
                                                                                                                                                          string,
                                                                                                                                                          I_SENDER)
                                                                                                                                                        (cons
                                                                                                                                                          ("SELF"
                                                                                                                                                            %
                                                                                                                                                            string,
                                                                                                                                                            I_SELF)
                                                                                                                                                          (cons
                                                                                                                                                            ("STEPS_TO_QUOTA"
                                                                                                                                                              %
                                                                                                                                                              string,
                                                                                                                                                              I_STEPS_TO_QUOTA)
                                                                                                                                                            (cons
                                                                                                                                                              ("SUB"
                                                                                                                                                                %
                                                                                                                                                                string,
                                                                                                                                                                I_SUB)
                                                                                                                                                              (cons
                                                                                                                                                                ("SWAP"
                                                                                                                                                                  %
                                                                                                                                                                  string,
                                                                                                                                                                  I_SWAP)
                                                                                                                                                                (cons
                                                                                                                                                                  ("TRANSFER_TOKENS"
                                                                                                                                                                    %
                                                                                                                                                                    string,
                                                                                                                                                                    I_TRANSFER_TOKENS)
                                                                                                                                                                  (cons
                                                                                                                                                                    ("SET_DELEGATE"
                                                                                                                                                                      %
                                                                                                                                                                      string,
                                                                                                                                                                      I_SET_DELEGATE)
                                                                                                                                                                    (cons
                                                                                                                                                                      ("UNIT"
                                                                                                                                                                        %
                                                                                                                                                                        string,
                                                                                                                                                                        I_UNIT)
                                                                                                                                                                      (cons
                                                                                                                                                                        ("UPDATE"
                                                                                                                                                                          %
                                                                                                                                                                          string,
                                                                                                                                                                          I_UPDATE)
                                                                                                                                                                        (cons
                                                                                                                                                                          ("XOR"
                                                                                                                                                                            %
                                                                                                                                                                            string,
                                                                                                                                                                            I_XOR)
                                                                                                                                                                          (cons
                                                                                                                                                                            ("ITER"
                                                                                                                                                                              %
                                                                                                                                                                              string,
                                                                                                                                                                              I_ITER)
                                                                                                                                                                            (cons
                                                                                                                                                                              ("LOOP_LEFT"
                                                                                                                                                                                %
                                                                                                                                                                                string,
                                                                                                                                                                                I_LOOP_LEFT)
                                                                                                                                                                              (cons
                                                                                                                                                                                ("ADDRESS"
                                                                                                                                                                                  %
                                                                                                                                                                                  string,
                                                                                                                                                                                  I_ADDRESS)
                                                                                                                                                                                (cons
                                                                                                                                                                                  ("CONTRACT"
                                                                                                                                                                                    %
                                                                                                                                                                                    string,
                                                                                                                                                                                    I_CONTRACT)
                                                                                                                                                                                  (cons
                                                                                                                                                                                    ("ISNAT"
                                                                                                                                                                                      %
                                                                                                                                                                                      string,
                                                                                                                                                                                      I_ISNAT)
                                                                                                                                                                                    (cons
                                                                                                                                                                                      ("CAST"
                                                                                                                                                                                        %
                                                                                                                                                                                        string,
                                                                                                                                                                                        I_CAST)
                                                                                                                                                                                      (cons
                                                                                                                                                                                        ("RENAME"
                                                                                                                                                                                          %
                                                                                                                                                                                          string,
                                                                                                                                                                                          I_RENAME)
                                                                                                                                                                                        (cons
                                                                                                                                                                                          ("bool"
                                                                                                                                                                                            %
                                                                                                                                                                                            string,
                                                                                                                                                                                            T_bool)
                                                                                                                                                                                          (cons
                                                                                                                                                                                            ("contract"
                                                                                                                                                                                              %
                                                                                                                                                                                              string,
                                                                                                                                                                                              T_contract)
                                                                                                                                                                                            (cons
                                                                                                                                                                                              ("int"
                                                                                                                                                                                                %
                                                                                                                                                                                                string,
                                                                                                                                                                                                T_int)
                                                                                                                                                                                              (cons
                                                                                                                                                                                                ("key"
                                                                                                                                                                                                  %
                                                                                                                                                                                                  string,
                                                                                                                                                                                                  T_key)
                                                                                                                                                                                                (cons
                                                                                                                                                                                                  ("key_hash"
                                                                                                                                                                                                    %
                                                                                                                                                                                                    string,
                                                                                                                                                                                                    T_key_hash)
                                                                                                                                                                                                  (cons
                                                                                                                                                                                                    ("lambda"
                                                                                                                                                                                                      %
                                                                                                                                                                                                      string,
                                                                                                                                                                                                      T_lambda)
                                                                                                                                                                                                    (cons
                                                                                                                                                                                                      ("list"
                                                                                                                                                                                                        %
                                                                                                                                                                                                        string,
                                                                                                                                                                                                        T_list)
                                                                                                                                                                                                      (cons
                                                                                                                                                                                                        ("map"
                                                                                                                                                                                                          %
                                                                                                                                                                                                          string,
                                                                                                                                                                                                          T_map)
                                                                                                                                                                                                        (cons
                                                                                                                                                                                                          ("big_map"
                                                                                                                                                                                                            %
                                                                                                                                                                                                            string,
                                                                                                                                                                                                            T_big_map)
                                                                                                                                                                                                          (cons
                                                                                                                                                                                                            ("nat"
                                                                                                                                                                                                              %
                                                                                                                                                                                                              string,
                                                                                                                                                                                                              T_nat)
                                                                                                                                                                                                            (cons
                                                                                                                                                                                                              ("option"
                                                                                                                                                                                                                %
                                                                                                                                                                                                                string,
                                                                                                                                                                                                                T_option)
                                                                                                                                                                                                              (cons
                                                                                                                                                                                                                ("or"
                                                                                                                                                                                                                  %
                                                                                                                                                                                                                  string,
                                                                                                                                                                                                                  T_or)
                                                                                                                                                                                                                (cons
                                                                                                                                                                                                                  ("pair"
                                                                                                                                                                                                                    %
                                                                                                                                                                                                                    string,
                                                                                                                                                                                                                    T_pair)
                                                                                                                                                                                                                  (cons
                                                                                                                                                                                                                    ("set"
                                                                                                                                                                                                                      %
                                                                                                                                                                                                                      string,
                                                                                                                                                                                                                      T_set)
                                                                                                                                                                                                                    (cons
                                                                                                                                                                                                                      ("signature"
                                                                                                                                                                                                                        %
                                                                                                                                                                                                                        string,
                                                                                                                                                                                                                        T_signature)
                                                                                                                                                                                                                      (cons
                                                                                                                                                                                                                        ("string"
                                                                                                                                                                                                                          %
                                                                                                                                                                                                                          string,
                                                                                                                                                                                                                          T_string)
                                                                                                                                                                                                                        (cons
                                                                                                                                                                                                                          ("bytes"
                                                                                                                                                                                                                            %
                                                                                                                                                                                                                            string,
                                                                                                                                                                                                                            T_bytes)
                                                                                                                                                                                                                          (cons
                                                                                                                                                                                                                            ("mutez"
                                                                                                                                                                                                                              %
                                                                                                                                                                                                                              string,
                                                                                                                                                                                                                              T_mutez)
                                                                                                                                                                                                                            (cons
                                                                                                                                                                                                                              ("timestamp"
                                                                                                                                                                                                                                %
                                                                                                                                                                                                                                string,
                                                                                                                                                                                                                                T_timestamp)
                                                                                                                                                                                                                              (cons
                                                                                                                                                                                                                                ("unit"
                                                                                                                                                                                                                                  %
                                                                                                                                                                                                                                  string,
                                                                                                                                                                                                                                  T_unit)
                                                                                                                                                                                                                                (cons
                                                                                                                                                                                                                                  ("operation"
                                                                                                                                                                                                                                    %
                                                                                                                                                                                                                                    string,
                                                                                                                                                                                                                                    T_operation)
                                                                                                                                                                                                                                  (cons
                                                                                                                                                                                                                                    ("address"
                                                                                                                                                                                                                                      %
                                                                                                                                                                                                                                      string,
                                                                                                                                                                                                                                      T_address)
                                                                                                                                                                                                                                    (cons
                                                                                                                                                                                                                                      ("SLICE"
                                                                                                                                                                                                                                        %
                                                                                                                                                                                                                                        string,
                                                                                                                                                                                                                                        I_SLICE)
                                                                                                                                                                                                                                      (cons
                                                                                                                                                                                                                                        ("DIG"
                                                                                                                                                                                                                                          %
                                                                                                                                                                                                                                          string,
                                                                                                                                                                                                                                          I_DIG)
                                                                                                                                                                                                                                        (cons
                                                                                                                                                                                                                                          ("DUG"
                                                                                                                                                                                                                                            %
                                                                                                                                                                                                                                            string,
                                                                                                                                                                                                                                            I_DUG)
                                                                                                                                                                                                                                          (cons
                                                                                                                                                                                                                                            ("EMPTY_BIG_MAP"
                                                                                                                                                                                                                                              %
                                                                                                                                                                                                                                              string,
                                                                                                                                                                                                                                              I_EMPTY_BIG_MAP)
                                                                                                                                                                                                                                            (cons
                                                                                                                                                                                                                                              ("APPLY"
                                                                                                                                                                                                                                                %
                                                                                                                                                                                                                                                string,
                                                                                                                                                                                                                                                I_APPLY)
                                                                                                                                                                                                                                              (cons
                                                                                                                                                                                                                                                ("chain_id"
                                                                                                                                                                                                                                                  %
                                                                                                                                                                                                                                                  string,
                                                                                                                                                                                                                                                  T_chain_id)
                                                                                                                                                                                                                                                (cons
                                                                                                                                                                                                                                                  ("CHAIN_ID"
                                                                                                                                                                                                                                                    %
                                                                                                                                                                                                                                                    string,
                                                                                                                                                                                                                                                    I_CHAIN_ID)
                                                                                                                                                                                                                                                  []))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))).

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.unknown_primitive_name" % string
      "Unknown primitive name" % string
      "In a script or data expression, a primitive was unknown." % string
      (Some
        (fun ppf =>
          fun n =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Unknown primitive " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                      "." % char
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Unknown primitive %s." % string) n))
      (obj1 (req None None "wrong_primitive_name" % string string))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unknown_primitive_name
            got => Some got
        | _ => None
        end)
      (fun got =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unknown_primitive_name
          got) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_primitive_name_case" % string
      "Invalid primitive name case" % string
      "In a script or data expression, a primitive name is neither uppercase, lowercase or capitalized."
        % string
      (Some
        (fun ppf =>
          fun n =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Primitive " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " has invalid case." % string
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
                "Primitive %s has invalid case." % string) n))
      (obj1 (req None None "wrong_primitive_name" % string string))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_case
            name => Some name
        | _ => None
        end)
      (fun name =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_case
          name) in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "michelson_v1.invalid_primitive_name" % string
    "Invalid primitive name" % string
    "In a script or data expression, a primitive name is unknown or has a wrong case."
      % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let '_ := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "Invalid primitive." % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "Invalid primitive." % string)))
    (obj2
      (req None None "expression" % string
        (Micheline.canonical_encoding "generic" % string string))
      (req None None "location" % string Micheline.canonical_location_encoding))
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_primitive_name
          expr loc => Some (expr, loc)
      | _ => None
      end)
    (fun function_parameter =>
      let '(expr, loc) := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_primitive_name
        expr loc).
michelson_v1_primitives.mli 4 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type error += Unknown_primitive_name of string (* `Permanent *)

type error += Invalid_case of string (* `Permanent *)

type error +=
  | Invalid_primitive_name of
      string Micheline.canonical * Micheline.canonical_location

(* `Permanent *)

type prim =
  | K_parameter
  | K_storage
  | K_code
  | D_False
  | D_Elt
  | D_Left
  | D_None
  | D_Pair
  | D_Right
  | D_Some
  | D_True
  | D_Unit
  | I_PACK
  | I_UNPACK
  | I_BLAKE2B
  | I_SHA256
  | I_SHA512
  | I_ABS
  | I_ADD
  | I_AMOUNT
  | I_AND
  | I_BALANCE
  | I_CAR
  | I_CDR
  | I_CHAIN_ID
  | I_CHECK_SIGNATURE
  | I_COMPARE
  | I_CONCAT
  | I_CONS
  | I_CREATE_ACCOUNT
  | I_CREATE_CONTRACT
  | I_IMPLICIT_ACCOUNT
  | I_DIP
  | I_DROP
  | I_DUP
  | I_EDIV
  | I_EMPTY_BIG_MAP
  | I_EMPTY_MAP
  | I_EMPTY_SET
  | I_EQ
  | I_EXEC
  | I_APPLY
  | I_FAILWITH
  | I_GE
  | I_GET
  | I_GT
  | I_HASH_KEY
  | I_IF
  | I_IF_CONS
  | I_IF_LEFT
  | I_IF_NONE
  | I_INT
  | I_LAMBDA
  | I_LE
  | I_LEFT
  | I_LOOP
  | I_LSL
  | I_LSR
  | I_LT
  | I_MAP
  | I_MEM
  | I_MUL
  | I_NEG
  | I_NEQ
  | I_NIL
  | I_NONE
  | I_NOT
  | I_NOW
  | I_OR
  | I_PAIR
  | I_PUSH
  | I_RIGHT
  | I_SIZE
  | I_SOME
  | I_SOURCE
  | I_SENDER
  | I_SELF
  | I_SLICE
  | I_STEPS_TO_QUOTA
  | I_SUB
  | I_SWAP
  | I_TRANSFER_TOKENS
  | I_SET_DELEGATE
  | I_UNIT
  | I_UPDATE
  | I_XOR
  | I_ITER
  | I_LOOP_LEFT
  | I_ADDRESS
  | I_CONTRACT
  | I_ISNAT
  | I_CAST
  | I_RENAME
  | I_DIG
  | I_DUG
  | T_bool
  | T_contract
  | T_int
  | T_key
  | T_key_hash
  | T_lambda
  | T_list
  | T_map
  | T_big_map
  | T_nat
  | T_option
  | T_or
  | T_pair
  | T_set
  | T_signature
  | T_string
  | T_bytes
  | T_mutez
  | T_timestamp
  | T_unit
  | T_operation
  | T_address
  | T_chain_id

val prim_encoding : prim Data_encoding.encoding

val string_of_prim : prim -> string

val prim_of_string : string -> prim tzresult

val prims_of_strings :
  string Micheline.canonical -> prim Micheline.canonical tzresult

val strings_of_prims : prim Micheline.canonical -> string Micheline.canonical
michelson_v1_primitives_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

extensible_type

extensible_type

extensible_type

Inductive prim : Type :=
| K_parameter : prim
| K_storage : prim
| K_code : prim
| D_False : prim
| D_Elt : prim
| D_Left : prim
| D_None : prim
| D_Pair : prim
| D_Right : prim
| D_Some : prim
| D_True : prim
| D_Unit : prim
| I_PACK : prim
| I_UNPACK : prim
| I_BLAKE2B : prim
| I_SHA256 : prim
| I_SHA512 : prim
| I_ABS : prim
| I_ADD : prim
| I_AMOUNT : prim
| I_AND : prim
| I_BALANCE : prim
| I_CAR : prim
| I_CDR : prim
| I_CHAIN_ID : prim
| I_CHECK_SIGNATURE : prim
| I_COMPARE : prim
| I_CONCAT : prim
| I_CONS : prim
| I_CREATE_ACCOUNT : prim
| I_CREATE_CONTRACT : prim
| I_IMPLICIT_ACCOUNT : prim
| I_DIP : prim
| I_DROP : prim
| I_DUP : prim
| I_EDIV : prim
| I_EMPTY_BIG_MAP : prim
| I_EMPTY_MAP : prim
| I_EMPTY_SET : prim
| I_EQ : prim
| I_EXEC : prim
| I_APPLY : prim
| I_FAILWITH : prim
| I_GE : prim
| I_GET : prim
| I_GT : prim
| I_HASH_KEY : prim
| I_IF : prim
| I_IF_CONS : prim
| I_IF_LEFT : prim
| I_IF_NONE : prim
| I_INT : prim
| I_LAMBDA : prim
| I_LE : prim
| I_LEFT : prim
| I_LOOP : prim
| I_LSL : prim
| I_LSR : prim
| I_LT : prim
| I_MAP : prim
| I_MEM : prim
| I_MUL : prim
| I_NEG : prim
| I_NEQ : prim
| I_NIL : prim
| I_NONE : prim
| I_NOT : prim
| I_NOW : prim
| I_OR : prim
| I_PAIR : prim
| I_PUSH : prim
| I_RIGHT : prim
| I_SIZE : prim
| I_SOME : prim
| I_SOURCE : prim
| I_SENDER : prim
| I_SELF : prim
| I_SLICE : prim
| I_STEPS_TO_QUOTA : prim
| I_SUB : prim
| I_SWAP : prim
| I_TRANSFER_TOKENS : prim
| I_SET_DELEGATE : prim
| I_UNIT : prim
| I_UPDATE : prim
| I_XOR : prim
| I_ITER : prim
| I_LOOP_LEFT : prim
| I_ADDRESS : prim
| I_CONTRACT : prim
| I_ISNAT : prim
| I_CAST : prim
| I_RENAME : prim
| I_DIG : prim
| I_DUG : prim
| T_bool : prim
| T_contract : prim
| T_int : prim
| T_key : prim
| T_key_hash : prim
| T_lambda : prim
| T_list : prim
| T_map : prim
| T_big_map : prim
| T_nat : prim
| T_option : prim
| T_or : prim
| T_pair : prim
| T_set : prim
| T_signature : prim
| T_string : prim
| T_bytes : prim
| T_mutez : prim
| T_timestamp : prim
| T_unit : prim
| T_operation : prim
| T_address : prim
| T_chain_id : prim.

Parameter prim_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding prim.

Parameter string_of_prim : prim -> string.

Parameter prim_of_string :
string ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult prim.

Parameter prims_of_strings :
Tezos_protocol_environment_alpha__Environment.Micheline.canonical string ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_protocol_environment_alpha__Environment.Micheline.canonical prim).

Parameter strings_of_prims :
Tezos_protocol_environment_alpha__Environment.Micheline.canonical prim ->
  Tezos_protocol_environment_alpha__Environment.Micheline.canonical string.
misc.ml 32 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type 'a lazyt = unit -> 'a

type 'a lazy_list_t = LCons of 'a * 'a lazy_list_t tzresult Lwt.t lazyt

type 'a lazy_list = 'a lazy_list_t tzresult Lwt.t

let rec ( --> ) i j =
  (* [i; i+1; ...; j] *)
  if Compare.Int.(i > j) then [] else i :: (succ i --> j)

let rec ( ---> ) i j =
  (* [i; i+1; ...; j] *)
  if Compare.Int32.(i > j) then [] else i :: (Int32.succ i ---> j)

let split delim ?(limit = max_int) path =
  let l = String.length path in
  let rec do_slashes acc limit i =
    if Compare.Int.(i >= l) then List.rev acc
    else if Compare.Char.(path.[i] = delim) then do_slashes acc limit (i + 1)
    else do_split acc limit i
  and do_split acc limit i =
    if Compare.Int.(limit <= 0) then
      if Compare.Int.(i = l) then List.rev acc
      else List.rev (String.sub path i (l - i) :: acc)
    else do_component acc (pred limit) i i
  and do_component acc limit i j =
    if Compare.Int.(j >= l) then
      if Compare.Int.(i = j) then List.rev acc
      else List.rev (String.sub path i (j - i) :: acc)
    else if Compare.Char.(path.[j] = delim) then
      do_slashes (String.sub path i (j - i) :: acc) limit j
    else do_component acc limit i (j + 1)
  in
  if Compare.Int.(limit > 0) then do_slashes [] limit 0 else [path]

let pp_print_paragraph ppf description =
  Format.fprintf
    ppf
    "@[%a@]"
    Format.(pp_print_list ~pp_sep:pp_print_space pp_print_string)
    (split ' ' description)

let take n l =
  let rec loop acc n = function
    | xs when Compare.Int.(n <= 0) ->
        Some (List.rev acc, xs)
    | [] ->
        None
    | x :: xs ->
        loop (x :: acc) (n - 1) xs
  in
  loop [] n l

let remove_prefix ~prefix s =
  let x = String.length prefix in
  let n = String.length s in
  if Compare.Int.(n >= x) && Compare.String.(String.sub s 0 x = prefix) then
    Some (String.sub s x (n - x))
  else None

let rec remove_elem_from_list nb = function
  | [] ->
      []
  | l when Compare.Int.(nb <= 0) ->
      l
  | _ :: tl ->
      remove_elem_from_list (nb - 1) tl
misc_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition lazyt (a : Type) := unit -> a.

Inductive lazy_list_t (a : Type) : Type :=
| LCons : a ->
  lazyt
    (Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (lazy_list_t a))) -> lazy_list_t a.

Arguments LCons {_}.

Definition lazy_list (a : Type) :=
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (lazy_list_t a)).

Fixpoint op_minusminusgt
  (i :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  (j :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : list
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t) :=
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
      i j then
    []
  else
    cons i (op_minusminusgt (succ i) j).

Fixpoint op_minusminusminusgt
  (i :
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  (j :
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : list
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.t) :=
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
      i j then
    []
  else
    cons i (op_minusminusminusgt (Int32.succ i) j).

Definition split
  (delim :
    Tezos_protocol_environment_alpha__Environment.Compare.Char.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  (op_staroptstar :
    option
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : string -> list string :=
  let limit :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => max_int
    end in
  fun path =>
    let l := String.length path in
    let fix do_slashes
      (acc : list string) (limit :
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
      (i :
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
      : list string :=
      if
        Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
          i l then
        List.rev acc
      else
        if
          Tezos_protocol_environment_alpha__Environment.Compare.Char.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
            (String.get path i) delim then
          do_slashes acc limit (op_plus i 1)
        else
          do_split acc limit i
    with do_split
      (acc : list string) (limit :
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
      (i :
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
      : list string :=
      if
        Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lteq)
          limit 0 then
        if
          Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
            i l then
          List.rev acc
        else
          List.rev (cons (String.sub path i (op_minus l i)) acc)
      else
        do_component acc (pred limit) i i
    with do_component
      (acc : list string) (limit :
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
      (i :
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
      (j :
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
      : list string :=
      if
        Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
          j l then
        if
          Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
            i j then
          List.rev acc
        else
          List.rev (cons (String.sub path i (op_minus j i)) acc)
      else
        if
          Tezos_protocol_environment_alpha__Environment.Compare.Char.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
            (String.get path j) delim then
          do_slashes (cons (String.sub path i (op_minus j i)) acc) limit j
        else
          do_component acc limit i (op_plus j 1) in
    if
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
        limit 0 then
      do_slashes [] limit 0
    else
      cons path [].

Definition pp_print_paragraph
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (description : string) : unit :=
  Format.fprintf ppf
    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_gen
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Open_box
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format
            "" % string))
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Close_box
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
      "@[%a@]" % string) (pp_print_list (Some pp_print_space) pp_print_string)
    (split " " % char None description).

Definition take {A : Type}
  (n :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  (l : list A) : option (list A * list A) :=
  let fix loop {B : Type}
    (acc : list B) (n :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
    (function_parameter : list B) : option (list B * list B) :=
    match function_parameter with
    | xs => Some ((List.rev acc), xs)
    | [] => None
    | cons x xs => loop (cons x acc) (op_minus n 1) xs
    end in
  loop [] n l.

Definition remove_prefix
  (prefix :
    Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  (s : string) : option string :=
  let x := String.length prefix in
  let n := String.length s in
  if
    op_andand
      (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
        n x)
      (Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
        (String.sub s 0 x) prefix) then
    Some (String.sub s x (op_minus n x))
  else
    None.

Fixpoint remove_elem_from_list {A : Type}
  (nb :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  (function_parameter : list A) : list A :=
  match function_parameter with
  | [] => []
  | l => l
  | cons _ tl => remove_elem_from_list (op_minus nb 1) tl
  end.
misc.mli 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** {2 Helper functions} *)

type 'a lazyt = unit -> 'a

type 'a lazy_list_t = LCons of 'a * 'a lazy_list_t tzresult Lwt.t lazyt

type 'a lazy_list = 'a lazy_list_t tzresult Lwt.t

(** Include bounds *)
val ( --> ) : int -> int -> int list

val ( ---> ) : Int32.t -> Int32.t -> Int32.t list

val pp_print_paragraph : Format.formatter -> string -> unit

val take : int -> 'a list -> ('a list * 'a list) option

(** Some (input with [prefix] removed), if string has [prefix], else [None] *)
val remove_prefix : prefix:string -> string -> string option

(** [remove nb list] remove the first [nb] elements from the list [list]. *)
val remove_elem_from_list : int -> 'a list -> 'a list
misc_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition lazyt (a : Type) := unit -> a.

Inductive lazy_list_t (a : Type) : Type :=
| LCons : a ->
  lazyt
    (Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (lazy_list_t a))) -> lazy_list_t a.

Arguments LCons {_}.

Definition lazy_list (a : Type) :=
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (lazy_list_t a)).

Parameter op_minusminusgt : Z -> Z -> list Z.

Parameter op_minusminusminusgt :
Tezos_protocol_environment_alpha__Environment.Int32.t ->
  Tezos_protocol_environment_alpha__Environment.Int32.t ->
    list Tezos_protocol_environment_alpha__Environment.Int32.t.

Parameter pp_print_paragraph :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> string -> unit.

Parameter take : forall {a : Type}, Z -> list a -> option (list a * list a).

Parameter remove_prefix : string -> string -> option string.

Parameter remove_elem_from_list : forall {a : Type}, Z -> list a -> list a.
nonce_hash.ml 3 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* 32 *)
let nonce_hash = "\069\220\169" (* nce(53) *)

include Blake2B.Make
          (Base58)
          (struct
            let name = "cycle_nonce"

            let title = "A nonce hash"

            let b58check_prefix = nonce_hash

            let size = None
          end)

let () = Base58.check_encoded_prefix b58check_encoding "nce" 53
nonce_hash_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition nonce_hash : string := "Eܩ" % string.

(* ❌ Cannot include this kind of module expression *)
include

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute Base58.check_encoded_prefix b58check_encoding "nce" % string 53.
nonce_storage.ml 10 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = Seed_repr.nonce

type nonce = t

let encoding = Seed_repr.nonce_encoding

type error +=
  | Too_late_revelation
  | Too_early_revelation
  | Previously_revealed_nonce
  | Unexpected_nonce

let () =
  register_error_kind
    `Branch
    ~id:"nonce.too_late_revelation"
    ~title:"Too late nonce revelation"
    ~description:"Nonce revelation happens too late"
    ~pp:(fun ppf () ->
      Format.fprintf ppf "This nonce cannot be revealed anymore.")
    Data_encoding.unit
    (function Too_late_revelation -> Some () | _ -> None)
    (fun () -> Too_late_revelation) ;
  register_error_kind
    `Temporary
    ~id:"nonce.too_early_revelation"
    ~title:"Too early nonce revelation"
    ~description:"Nonce revelation happens before cycle end"
    ~pp:(fun ppf () ->
      Format.fprintf ppf "This nonce should not yet be revealed")
    Data_encoding.unit
    (function Too_early_revelation -> Some () | _ -> None)
    (fun () -> Too_early_revelation) ;
  register_error_kind
    `Branch
    ~id:"nonce.previously_revealed"
    ~title:"Previously revealed nonce"
    ~description:"Duplicated revelation for a nonce."
    ~pp:(fun ppf () -> Format.fprintf ppf "This nonce was previously revealed")
    Data_encoding.unit
    (function Previously_revealed_nonce -> Some () | _ -> None)
    (fun () -> Previously_revealed_nonce) ;
  register_error_kind
    `Branch
    ~id:"nonce.unexpected"
    ~title:"Unexpected nonce"
    ~description:
      "The provided nonce is inconsistent with the committed nonce hash."
    ~pp:(fun ppf () ->
      Format.fprintf
        ppf
        "This nonce revelation is invalid (inconsistent with the committed \
         hash)")
    Data_encoding.unit
    (function Unexpected_nonce -> Some () | _ -> None)
    (fun () -> Unexpected_nonce)

(* checks that the level of a revelation is not too early or too late wrt to the
   current context and that a nonce has not been already revealed for that level *)
let get_unrevealed ctxt level =
  let cur_level = Level_storage.current ctxt in
  match Cycle_repr.pred cur_level.cycle with
  | None ->
      fail Too_early_revelation (* no revelations during cycle 0 *)
  | Some revealed_cycle -> (
      if Cycle_repr.(revealed_cycle < level.Level_repr.cycle) then
        fail Too_early_revelation
      else if Cycle_repr.(level.Level_repr.cycle < revealed_cycle) then
        fail Too_late_revelation
      else
        Storage.Seed.Nonce.get ctxt level
        >>=? function
        | Revealed _ ->
            fail Previously_revealed_nonce
        | Unrevealed status ->
            return status )

let record_hash ctxt unrevealed =
  let level = Level_storage.current ctxt in
  Storage.Seed.Nonce.init ctxt level (Unrevealed unrevealed)

let reveal ctxt level nonce =
  get_unrevealed ctxt level
  >>=? fun unrevealed ->
  fail_unless
    (Seed_repr.check_hash nonce unrevealed.nonce_hash)
    Unexpected_nonce
  >>=? fun () ->
  Storage.Seed.Nonce.set ctxt level (Revealed nonce)
  >>=? fun ctxt -> return ctxt

type unrevealed = Storage.Seed.unrevealed_nonce = {
  nonce_hash : Nonce_hash.t;
  delegate : Signature.Public_key_hash.t;
  rewards : Tez_repr.t;
  fees : Tez_repr.t;
}

type status = Storage.Seed.nonce_status =
  | Unrevealed of unrevealed
  | Revealed of Seed_repr.nonce

let get = Storage.Seed.Nonce.get

let of_bytes = Seed_repr.make_nonce

let hash = Seed_repr.hash

let check_hash = Seed_repr.check_hash
nonce_storage_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition t := Tezos_raw_protocol_alpha.Seed_repr.nonce.

Definition nonce := t.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    Tezos_raw_protocol_alpha.Seed_repr.nonce := Seed_repr.nonce_encoding.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "nonce.too_late_revelation" % string
      "Too late nonce revelation" % string
      "Nonce revelation happens too late" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "This nonce cannot be revealed anymore." % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "This nonce cannot be revealed anymore." % string)))
      Data_encoding.unit
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Too_late_revelation
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Too_late_revelation)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "nonce.too_early_revelation" % string
      "Too early nonce revelation" % string
      "Nonce revelation happens before cycle end" % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "This nonce should not yet be revealed" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "This nonce should not yet be revealed" % string)))
      Data_encoding.unit
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_revelation
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_revelation)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "nonce.previously_revealed" % string
      "Previously revealed nonce" % string
      "Duplicated revelation for a nonce." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "This nonce was previously revealed" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "This nonce was previously revealed" % string)))
      Data_encoding.unit
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Previously_revealed_nonce
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Previously_revealed_nonce)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "nonce.unexpected" % string "Unexpected nonce" % string
    "The provided nonce is inconsistent with the committed nonce hash." % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "This nonce revelation is invalid (inconsistent with the committed hash)"
                  % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "This nonce revelation is invalid (inconsistent with the committed hash)"
                % string))) Data_encoding.unit
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_nonce
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_nonce).

Definition get_unrevealed
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (level : Tezos_raw_protocol_alpha.Level_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha__Storage.Seed.unrevealed_nonce) :=
  let cur_level := Level_storage.current ctxt in
  match Cycle_repr.pred (cycle cur_level) with
  | None =>
    fail
      Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_revelation
  | Some revealed_cycle =>
    if op_lt revealed_cycle (Level_repr.cycle level) then
      fail
        Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_revelation
    else
      if op_lt (Level_repr.cycle level) revealed_cycle then
        fail
          Tezos_protocol_environment_alpha__Environment.Error_monad.Too_late_revelation
      else
        op_gtgteqquestion (Storage.Seed.Nonce.get ctxt level)
          (fun function_parameter =>
            match function_parameter with
            | Tezos_raw_protocol_alpha__Storage.Seed.Revealed _ =>
              fail
                Tezos_protocol_environment_alpha__Environment.Error_monad.Previously_revealed_nonce
            | Tezos_raw_protocol_alpha__Storage.Seed.Unrevealed status =>
              __return status
            end)
  end.

Definition record_hash
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (unrevealed : Tezos_raw_protocol_alpha__Storage.Seed.unrevealed_nonce)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let level := Level_storage.current ctxt in
  Storage.Seed.Nonce.init ctxt level
    (Tezos_raw_protocol_alpha__Storage.Seed.Unrevealed unrevealed).

Definition reveal
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  (level : Tezos_raw_protocol_alpha.Level_repr.t)
  (nonce : Tezos_raw_protocol_alpha.Seed_repr.nonce)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteqquestion (get_unrevealed ctxt level)
    (fun unrevealed =>
      op_gtgteqquestion
        (fail_unless (Seed_repr.check_hash nonce (nonce_hash unrevealed))
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_nonce)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgteqquestion
            (Storage.Seed.Nonce.set ctxt level
              (Tezos_raw_protocol_alpha__Storage.Seed.Revealed nonce))
            (fun ctxt => __return ctxt))).

Record unrevealed := {
  nonce_hash : Tezos_raw_protocol_alpha.Nonce_hash.t;
  delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
  rewards : Tezos_raw_protocol_alpha.Tez_repr.t;
  fees : Tezos_raw_protocol_alpha.Tez_repr.t }.

Inductive status : Type :=
| Unrevealed : unrevealed -> status
| Revealed : Tezos_raw_protocol_alpha.Seed_repr.nonce -> status.

Definition get
  : Tezos_raw_protocol_alpha.Storage.Seed.Nonce.context ->
    Tezos_raw_protocol_alpha.Level_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha__Storage.Seed.nonce_status) :=
  Storage.Seed.Nonce.get.

Definition of_bytes
  : Tezos_protocol_environment_alpha__Environment.MBytes.t ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Seed_repr.nonce := Seed_repr.make_nonce.

Definition hash
  : Tezos_raw_protocol_alpha.Seed_repr.nonce ->
    Tezos_raw_protocol_alpha.Nonce_hash.t := Seed_repr.hash.

Definition check_hash
  : Tezos_raw_protocol_alpha.Seed_repr.nonce ->
    Tezos_raw_protocol_alpha.Nonce_hash.t -> bool := Seed_repr.check_hash.
nonce_storage.mli 2 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type error +=
  | Too_late_revelation
  | Too_early_revelation
  | Previously_revealed_nonce
  | Unexpected_nonce

type t = Seed_repr.nonce

type nonce = t

val encoding : nonce Data_encoding.t

type unrevealed = Storage.Seed.unrevealed_nonce = {
  nonce_hash : Nonce_hash.t;
  delegate : Signature.Public_key_hash.t;
  rewards : Tez_repr.t;
  fees : Tez_repr.t;
}

type status = Unrevealed of unrevealed | Revealed of Seed_repr.nonce

val get : Raw_context.t -> Level_repr.t -> status tzresult Lwt.t

val record_hash : Raw_context.t -> unrevealed -> Raw_context.t tzresult Lwt.t

val reveal :
  Raw_context.t -> Level_repr.t -> nonce -> Raw_context.t tzresult Lwt.t

val of_bytes : MBytes.t -> nonce tzresult

val hash : nonce -> Nonce_hash.t

val check_hash : nonce -> Nonce_hash.t -> bool
nonce_storage_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

extensible_type

Definition t := Tezos_raw_protocol_alpha.Seed_repr.nonce.

Definition nonce := t.

Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t nonce.

Record unrevealed := {
  nonce_hash : Tezos_raw_protocol_alpha.Nonce_hash.t;
  delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
  rewards : Tezos_raw_protocol_alpha.Tez_repr.t;
  fees : Tezos_raw_protocol_alpha.Tez_repr.t }.

Inductive status : Type :=
| Unrevealed : unrevealed -> status
| Revealed : Tezos_raw_protocol_alpha.Seed_repr.nonce -> status.

Parameter get :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Level_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult status).

Parameter record_hash :
Tezos_raw_protocol_alpha.Raw_context.t ->
  unrevealed ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).

Parameter reveal :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Level_repr.t ->
    nonce ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).

Parameter of_bytes :
Tezos_protocol_environment_alpha__Environment.MBytes.t ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult nonce.

Parameter hash : nonce -> Tezos_raw_protocol_alpha.Nonce_hash.t.

Parameter check_hash : nonce -> Tezos_raw_protocol_alpha.Nonce_hash.t -> bool.
operation_repr.ml 37 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* Tezos Protocol Implementation - Low level Repr. of Operations *)

module Kind = struct
  type seed_nonce_revelation = Seed_nonce_revelation_kind

  type double_endorsement_evidence = Double_endorsement_evidence_kind

  type double_baking_evidence = Double_baking_evidence_kind

  type activate_account = Activate_account_kind

  type endorsement = Endorsement_kind

  type proposals = Proposals_kind

  type ballot = Ballot_kind

  type reveal = Reveal_kind

  type transaction = Transaction_kind

  type origination = Origination_kind

  type delegation = Delegation_kind

  type 'a manager =
    | Reveal_manager_kind : reveal manager
    | Transaction_manager_kind : transaction manager
    | Origination_manager_kind : origination manager
    | Delegation_manager_kind : delegation manager
end

type raw = Operation.t = {shell : Operation.shell_header; proto : MBytes.t}

let raw_encoding = Operation.encoding

type 'kind operation = {
  shell : Operation.shell_header;
  protocol_data : 'kind protocol_data;
}

and 'kind protocol_data = {
  contents : 'kind contents_list;
  signature : Signature.t option;
}

and _ contents_list =
  | Single : 'kind contents -> 'kind contents_list
  | Cons :
      'kind Kind.manager contents * 'rest Kind.manager contents_list
      -> ('kind * 'rest) Kind.manager contents_list

and _ contents =
  | Endorsement : {level : Raw_level_repr.t} -> Kind.endorsement contents
  | Seed_nonce_revelation : {
      level : Raw_level_repr.t;
      nonce : Seed_repr.nonce;
    }
      -> Kind.seed_nonce_revelation contents
  | Double_endorsement_evidence : {
      op1 : Kind.endorsement operation;
      op2 : Kind.endorsement operation;
    }
      -> Kind.double_endorsement_evidence contents
  | Double_baking_evidence : {
      bh1 : Block_header_repr.t;
      bh2 : Block_header_repr.t;
    }
      -> Kind.double_baking_evidence contents
  | Activate_account : {
      id : Ed25519.Public_key_hash.t;
      activation_code : Blinded_public_key_hash.activation_code;
    }
      -> Kind.activate_account contents
  | Proposals : {
      source : Signature.Public_key_hash.t;
      period : Voting_period_repr.t;
      proposals : Protocol_hash.t list;
    }
      -> Kind.proposals contents
  | Ballot : {
      source : Signature.Public_key_hash.t;
      period : Voting_period_repr.t;
      proposal : Protocol_hash.t;
      ballot : Vote_repr.ballot;
    }
      -> Kind.ballot contents
  | Manager_operation : {
      source : Signature.public_key_hash;
      fee : Tez_repr.tez;
      counter : counter;
      operation : 'kind manager_operation;
      gas_limit : Z.t;
      storage_limit : Z.t;
    }
      -> 'kind Kind.manager contents

and _ manager_operation =
  | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation
  | Transaction : {
      amount : Tez_repr.tez;
      parameters : Script_repr.lazy_expr;
      entrypoint : string;
      destination : Contract_repr.contract;
    }
      -> Kind.transaction manager_operation
  | Origination : {
      delegate : Signature.Public_key_hash.t option;
      script : Script_repr.t;
      credit : Tez_repr.tez;
      preorigination : Contract_repr.t option;
    }
      -> Kind.origination manager_operation
  | Delegation :
      Signature.Public_key_hash.t option
      -> Kind.delegation manager_operation

and counter = Z.t

let manager_kind : type kind. kind manager_operation -> kind Kind.manager =
  function
  | Reveal _ ->
      Kind.Reveal_manager_kind
  | Transaction _ ->
      Kind.Transaction_manager_kind
  | Origination _ ->
      Kind.Origination_manager_kind
  | Delegation _ ->
      Kind.Delegation_manager_kind

type 'kind internal_operation = {
  source : Contract_repr.contract;
  operation : 'kind manager_operation;
  nonce : int;
}

type packed_manager_operation =
  | Manager : 'kind manager_operation -> packed_manager_operation

type packed_contents = Contents : 'kind contents -> packed_contents

type packed_contents_list =
  | Contents_list : 'kind contents_list -> packed_contents_list

type packed_protocol_data =
  | Operation_data : 'kind protocol_data -> packed_protocol_data

type packed_operation = {
  shell : Operation.shell_header;
  protocol_data : packed_protocol_data;
}

let pack ({shell; protocol_data} : _ operation) : packed_operation =
  {shell; protocol_data = Operation_data protocol_data}

type packed_internal_operation =
  | Internal_operation : 'kind internal_operation -> packed_internal_operation

let rec to_list = function
  | Contents_list (Single o) ->
      [Contents o]
  | Contents_list (Cons (o, os)) ->
      Contents o :: to_list (Contents_list os)

let rec of_list = function
  | [] ->
      assert false
  | [Contents o] ->
      Contents_list (Single o)
  | Contents o :: os -> (
      let (Contents_list os) = of_list os in
      match (o, os) with
      | (Manager_operation _, Single (Manager_operation _)) ->
          Contents_list (Cons (o, os))
      | (Manager_operation _, Cons _) ->
          Contents_list (Cons (o, os))
      | _ ->
          Pervasives.failwith
            "Operation list of length > 1 should only contains manager \
             operations." )

module Encoding = struct
  open Data_encoding

  let case tag name args proj inj =
    let open Data_encoding in
    case
      tag
      ~title:(String.capitalize_ascii name)
      (merge_objs (obj1 (req "kind" (constant name))) args)
      (fun x -> match proj x with None -> None | Some x -> Some ((), x))
      (fun ((), x) -> inj x)

  module Manager_operations = struct
    type 'kind case =
      | MCase : {
          tag : int;
          name : string;
          encoding : 'a Data_encoding.t;
          select : packed_manager_operation -> 'kind manager_operation option;
          proj : 'kind manager_operation -> 'a;
          inj : 'a -> 'kind manager_operation;
        }
          -> 'kind case

    let reveal_case =
      MCase
        {
          tag = 0;
          name = "reveal";
          encoding = obj1 (req "public_key" Signature.Public_key.encoding);
          select = (function Manager (Reveal _ as op) -> Some op | _ -> None);
          proj = (function Reveal pkh -> pkh);
          inj = (fun pkh -> Reveal pkh);
        }

    let entrypoint_encoding =
      def
        ~title:"entrypoint"
        ~description:"Named entrypoint to a Michelson smart contract"
        "entrypoint"
      @@
      let builtin_case tag name =
        Data_encoding.case
          (Tag tag)
          ~title:name
          (constant name)
          (fun n -> if Compare.String.(n = name) then Some () else None)
          (fun () -> name)
      in
      union
        [ builtin_case 0 "default";
          builtin_case 1 "root";
          builtin_case 2 "do";
          builtin_case 3 "set_delegate";
          builtin_case 4 "remove_delegate";
          Data_encoding.case
            (Tag 255)
            ~title:"named"
            (Bounded.string 31)
            (fun s -> Some s)
            (fun s -> s) ]

    let transaction_case =
      MCase
        {
          tag = 1;
          name = "transaction";
          encoding =
            obj3
              (req "amount" Tez_repr.encoding)
              (req "destination" Contract_repr.encoding)
              (opt
                 "parameters"
                 (obj2
                    (req "entrypoint" entrypoint_encoding)
                    (req "value" Script_repr.lazy_expr_encoding)));
          select =
            (function Manager (Transaction _ as op) -> Some op | _ -> None);
          proj =
            (function
            | Transaction {amount; destination; parameters; entrypoint} ->
                let parameters =
                  if
                    Script_repr.is_unit_parameter parameters
                    && Compare.String.(entrypoint = "default")
                  then None
                  else Some (entrypoint, parameters)
                in
                (amount, destination, parameters));
          inj =
            (fun (amount, destination, parameters) ->
              let (entrypoint, parameters) =
                match parameters with
                | None ->
                    ("default", Script_repr.unit_parameter)
                | Some (entrypoint, value) ->
                    (entrypoint, value)
              in
              Transaction {amount; destination; parameters; entrypoint});
        }

    let origination_case =
      MCase
        {
          tag = 2;
          name = "origination";
          encoding =
            obj3
              (req "balance" Tez_repr.encoding)
              (opt "delegate" Signature.Public_key_hash.encoding)
              (req "script" Script_repr.encoding);
          select =
            (function Manager (Origination _ as op) -> Some op | _ -> None);
          proj =
            (function
            | Origination
                { credit;
                  delegate;
                  script;
                  preorigination =
                    _
                    (* the hash is only used internally
                               when originating from smart
                               contracts, don't serialize it *)
                } ->
                (credit, delegate, script));
          inj =
            (fun (credit, delegate, script) ->
              Origination {credit; delegate; script; preorigination = None});
        }

    let delegation_case =
      MCase
        {
          tag = 3;
          name = "delegation";
          encoding = obj1 (opt "delegate" Signature.Public_key_hash.encoding);
          select =
            (function Manager (Delegation _ as op) -> Some op | _ -> None);
          proj = (function Delegation key -> key);
          inj = (fun key -> Delegation key);
        }

    let encoding =
      let make (MCase {tag; name; encoding; select; proj; inj}) =
        case
          (Tag tag)
          name
          encoding
          (fun o ->
            match select o with None -> None | Some o -> Some (proj o))
          (fun x -> Manager (inj x))
      in
      union
        ~tag_size:`Uint8
        [ make reveal_case;
          make transaction_case;
          make origination_case;
          make delegation_case ]
  end

  type 'b case =
    | Case : {
        tag : int;
        name : string;
        encoding : 'a Data_encoding.t;
        select : packed_contents -> 'b contents option;
        proj : 'b contents -> 'a;
        inj : 'a -> 'b contents;
      }
        -> 'b case

  let endorsement_encoding = obj1 (req "level" Raw_level_repr.encoding)

  let endorsement_case =
    Case
      {
        tag = 0;
        name = "endorsement";
        encoding = endorsement_encoding;
        select =
          (function Contents (Endorsement _ as op) -> Some op | _ -> None);
        proj = (fun (Endorsement {level}) -> level);
        inj = (fun level -> Endorsement {level});
      }

  let endorsement_encoding =
    let make (Case {tag; name; encoding; select = _; proj; inj}) =
      case (Tag tag) name encoding (fun o -> Some (proj o)) (fun x -> inj x)
    in
    let to_list : Kind.endorsement contents_list -> _ = function
      | Single o ->
          o
    in
    let of_list : Kind.endorsement contents -> _ = function o -> Single o in
    def "inlined.endorsement"
    @@ conv
         (fun ({shell; protocol_data = {contents; signature}} : _ operation) ->
           (shell, (contents, signature)))
         (fun (shell, (contents, signature)) ->
           ({shell; protocol_data = {contents; signature}} : _ operation))
         (merge_objs
            Operation.shell_header_encoding
            (obj2
               (req
                  "operations"
                  ( conv to_list of_list
                  @@ def "inlined.endorsement.contents"
                  @@ union [make endorsement_case] ))
               (varopt "signature" Signature.encoding)))

  let seed_nonce_revelation_case =
    Case
      {
        tag = 1;
        name = "seed_nonce_revelation";
        encoding =
          obj2
            (req "level" Raw_level_repr.encoding)
            (req "nonce" Seed_repr.nonce_encoding);
        select =
          (function
          | Contents (Seed_nonce_revelation _ as op) -> Some op | _ -> None);
        proj = (fun (Seed_nonce_revelation {level; nonce}) -> (level, nonce));
        inj = (fun (level, nonce) -> Seed_nonce_revelation {level; nonce});
      }

  let double_endorsement_evidence_case : Kind.double_endorsement_evidence case
      =
    Case
      {
        tag = 2;
        name = "double_endorsement_evidence";
        encoding =
          obj2
            (req "op1" (dynamic_size endorsement_encoding))
            (req "op2" (dynamic_size endorsement_encoding));
        select =
          (function
          | Contents (Double_endorsement_evidence _ as op) ->
              Some op
          | _ ->
              None);
        proj = (fun (Double_endorsement_evidence {op1; op2}) -> (op1, op2));
        inj = (fun (op1, op2) -> Double_endorsement_evidence {op1; op2});
      }

  let double_baking_evidence_case =
    Case
      {
        tag = 3;
        name = "double_baking_evidence";
        encoding =
          obj2
            (req "bh1" (dynamic_size Block_header_repr.encoding))
            (req "bh2" (dynamic_size Block_header_repr.encoding));
        select =
          (function
          | Contents (Double_baking_evidence _ as op) -> Some op | _ -> None);
        proj = (fun (Double_baking_evidence {bh1; bh2}) -> (bh1, bh2));
        inj = (fun (bh1, bh2) -> Double_baking_evidence {bh1; bh2});
      }

  let activate_account_case =
    Case
      {
        tag = 4;
        name = "activate_account";
        encoding =
          obj2
            (req "pkh" Ed25519.Public_key_hash.encoding)
            (req "secret" Blinded_public_key_hash.activation_code_encoding);
        select =
          (function
          | Contents (Activate_account _ as op) -> Some op | _ -> None);
        proj =
          (fun (Activate_account {id; activation_code}) ->
            (id, activation_code));
        inj =
          (fun (id, activation_code) -> Activate_account {id; activation_code});
      }

  let proposals_case =
    Case
      {
        tag = 5;
        name = "proposals";
        encoding =
          obj3
            (req "source" Signature.Public_key_hash.encoding)
            (req "period" Voting_period_repr.encoding)
            (req "proposals" (list Protocol_hash.encoding));
        select =
          (function Contents (Proposals _ as op) -> Some op | _ -> None);
        proj =
          (fun (Proposals {source; period; proposals}) ->
            (source, period, proposals));
        inj =
          (fun (source, period, proposals) ->
            Proposals {source; period; proposals});
      }

  let ballot_case =
    Case
      {
        tag = 6;
        name = "ballot";
        encoding =
          obj4
            (req "source" Signature.Public_key_hash.encoding)
            (req "period" Voting_period_repr.encoding)
            (req "proposal" Protocol_hash.encoding)
            (req "ballot" Vote_repr.ballot_encoding);
        select = (function Contents (Ballot _ as op) -> Some op | _ -> None);
        proj =
          (function
          | Ballot {source; period; proposal; ballot} ->
              (source, period, proposal, ballot));
        inj =
          (fun (source, period, proposal, ballot) ->
            Ballot {source; period; proposal; ballot});
      }

  let manager_encoding =
    obj5
      (req "source" Signature.Public_key_hash.encoding)
      (req "fee" Tez_repr.encoding)
      (req "counter" (check_size 10 n))
      (req "gas_limit" (check_size 10 n))
      (req "storage_limit" (check_size 10 n))

  let extract (type kind)
      (Manager_operation
         {source; fee; counter; gas_limit; storage_limit; operation = _} :
        kind Kind.manager contents) =
    (source, fee, counter, gas_limit, storage_limit)

  let rebuild (source, fee, counter, gas_limit, storage_limit) operation =
    Manager_operation
      {source; fee; counter; gas_limit; storage_limit; operation}

  let make_manager_case tag (type kind)
      (Manager_operations.MCase mcase : kind Manager_operations.case) =
    Case
      {
        tag;
        name = mcase.name;
        encoding = merge_objs manager_encoding mcase.encoding;
        select =
          (function
          | Contents (Manager_operation ({operation; _} as op)) -> (
            match mcase.select (Manager operation) with
            | None ->
                None
            | Some operation ->
                Some (Manager_operation {op with operation}) )
          | _ ->
              None);
        proj =
          (function
          | Manager_operation {operation; _} as op ->
              (extract op, mcase.proj operation));
        inj = (fun (op, contents) -> rebuild op (mcase.inj contents));
      }

  let reveal_case = make_manager_case 107 Manager_operations.reveal_case

  let transaction_case =
    make_manager_case 108 Manager_operations.transaction_case

  let origination_case =
    make_manager_case 109 Manager_operations.origination_case

  let delegation_case =
    make_manager_case 110 Manager_operations.delegation_case

  let contents_encoding =
    let make (Case {tag; name; encoding; select; proj; inj}) =
      case
        (Tag tag)
        name
        encoding
        (fun o -> match select o with None -> None | Some o -> Some (proj o))
        (fun x -> Contents (inj x))
    in
    def "operation.alpha.contents"
    @@ union
         [ make endorsement_case;
           make seed_nonce_revelation_case;
           make double_endorsement_evidence_case;
           make double_baking_evidence_case;
           make activate_account_case;
           make proposals_case;
           make ballot_case;
           make reveal_case;
           make transaction_case;
           make origination_case;
           make delegation_case ]

  let contents_list_encoding =
    conv to_list of_list (Variable.list contents_encoding)

  let optional_signature_encoding =
    conv
      (function Some s -> s | None -> Signature.zero)
      (fun s -> if Signature.equal s Signature.zero then None else Some s)
      Signature.encoding

  let protocol_data_encoding =
    def "operation.alpha.contents_and_signature"
    @@ conv
         (fun (Operation_data {contents; signature}) ->
           (Contents_list contents, signature))
         (fun (Contents_list contents, signature) ->
           Operation_data {contents; signature})
         (obj2
            (req "contents" contents_list_encoding)
            (req "signature" optional_signature_encoding))

  let operation_encoding =
    conv
      (fun {shell; protocol_data} -> (shell, protocol_data))
      (fun (shell, protocol_data) -> {shell; protocol_data})
      (merge_objs Operation.shell_header_encoding protocol_data_encoding)

  let unsigned_operation_encoding =
    def "operation.alpha.unsigned_operation"
    @@ merge_objs
         Operation.shell_header_encoding
         (obj1 (req "contents" contents_list_encoding))

  let internal_operation_encoding =
    def "operation.alpha.internal_operation"
    @@ conv
         (fun (Internal_operation {source; operation; nonce}) ->
           ((source, nonce), Manager operation))
         (fun ((source, nonce), Manager operation) ->
           Internal_operation {source; operation; nonce})
         (merge_objs
            (obj2 (req "source" Contract_repr.encoding) (req "nonce" uint16))
            Manager_operations.encoding)
end

let encoding = Encoding.operation_encoding

let contents_encoding = Encoding.contents_encoding

let contents_list_encoding = Encoding.contents_list_encoding

let protocol_data_encoding = Encoding.protocol_data_encoding

let unsigned_operation_encoding = Encoding.unsigned_operation_encoding

let internal_operation_encoding = Encoding.internal_operation_encoding

let raw ({shell; protocol_data} : _ operation) =
  let proto =
    Data_encoding.Binary.to_bytes_exn
      protocol_data_encoding
      (Operation_data protocol_data)
  in
  {Operation.shell; proto}

let acceptable_passes (op : packed_operation) =
  let (Operation_data protocol_data) = op.protocol_data in
  match protocol_data.contents with
  | Single (Endorsement _) ->
      [0]
  | Single (Proposals _) ->
      [1]
  | Single (Ballot _) ->
      [1]
  | Single (Seed_nonce_revelation _) ->
      [2]
  | Single (Double_endorsement_evidence _) ->
      [2]
  | Single (Double_baking_evidence _) ->
      [2]
  | Single (Activate_account _) ->
      [2]
  | Single (Manager_operation _) ->
      [3]
  | Cons _ ->
      [3]

type error += Invalid_signature (* `Permanent *)

type error += Missing_signature (* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"operation.invalid_signature"
    ~title:"Invalid operation signature"
    ~description:
      "The operation signature is ill-formed or has been made with the wrong \
       public key"
    ~pp:(fun ppf () -> Format.fprintf ppf "The operation signature is invalid")
    Data_encoding.unit
    (function Invalid_signature -> Some () | _ -> None)
    (fun () -> Invalid_signature) ;
  register_error_kind
    `Permanent
    ~id:"operation.missing_signature"
    ~title:"Missing operation signature"
    ~description:
      "The operation is of a kind that must be signed, but the signature is \
       missing"
    ~pp:(fun ppf () -> Format.fprintf ppf "The operation requires a signature")
    Data_encoding.unit
    (function Missing_signature -> Some () | _ -> None)
    (fun () -> Missing_signature)

let check_signature_sync (type kind) key chain_id
    ({shell; protocol_data} : kind operation) =
  let check ~watermark contents signature =
    let unsigned_operation =
      Data_encoding.Binary.to_bytes_exn
        unsigned_operation_encoding
        (shell, contents)
    in
    if Signature.check ~watermark key signature unsigned_operation then Ok ()
    else error Invalid_signature
  in
  match (protocol_data.contents, protocol_data.signature) with
  | (Single _, None) ->
      error Missing_signature
  | (Cons _, None) ->
      error Missing_signature
  | ((Single (Endorsement _) as contents), Some signature) ->
      check
        ~watermark:(Endorsement chain_id)
        (Contents_list contents)
        signature
  | ((Single _ as contents), Some signature) ->
      check ~watermark:Generic_operation (Contents_list contents) signature
  | ((Cons _ as contents), Some signature) ->
      check ~watermark:Generic_operation (Contents_list contents) signature

let check_signature pk chain_id op =
  Lwt.return (check_signature_sync pk chain_id op)

let hash_raw = Operation.hash

let hash (o : _ operation) =
  let proto =
    Data_encoding.Binary.to_bytes_exn
      protocol_data_encoding
      (Operation_data o.protocol_data)
  in
  Operation.hash {shell = o.shell; proto}

let hash_packed (o : packed_operation) =
  let proto =
    Data_encoding.Binary.to_bytes_exn protocol_data_encoding o.protocol_data
  in
  Operation.hash {shell = o.shell; proto}

type ('a, 'b) eq = Eq : ('a, 'a) eq

let equal_manager_operation_kind :
    type a b. a manager_operation -> b manager_operation -> (a, b) eq option =
 fun op1 op2 ->
  match (op1, op2) with
  | (Reveal _, Reveal _) ->
      Some Eq
  | (Reveal _, _) ->
      None
  | (Transaction _, Transaction _) ->
      Some Eq
  | (Transaction _, _) ->
      None
  | (Origination _, Origination _) ->
      Some Eq
  | (Origination _, _) ->
      None
  | (Delegation _, Delegation _) ->
      Some Eq
  | (Delegation _, _) ->
      None

let equal_contents_kind :
    type a b. a contents -> b contents -> (a, b) eq option =
 fun op1 op2 ->
  match (op1, op2) with
  | (Endorsement _, Endorsement _) ->
      Some Eq
  | (Endorsement _, _) ->
      None
  | (Seed_nonce_revelation _, Seed_nonce_revelation _) ->
      Some Eq
  | (Seed_nonce_revelation _, _) ->
      None
  | (Double_endorsement_evidence _, Double_endorsement_evidence _) ->
      Some Eq
  | (Double_endorsement_evidence _, _) ->
      None
  | (Double_baking_evidence _, Double_baking_evidence _) ->
      Some Eq
  | (Double_baking_evidence _, _) ->
      None
  | (Activate_account _, Activate_account _) ->
      Some Eq
  | (Activate_account _, _) ->
      None
  | (Proposals _, Proposals _) ->
      Some Eq
  | (Proposals _, _) ->
      None
  | (Ballot _, Ballot _) ->
      Some Eq
  | (Ballot _, _) ->
      None
  | (Manager_operation op1, Manager_operation op2) -> (
    match equal_manager_operation_kind op1.operation op2.operation with
    | None ->
        None
    | Some Eq ->
        Some Eq )
  | (Manager_operation _, _) ->
      None

let rec equal_contents_kind_list :
    type a b. a contents_list -> b contents_list -> (a, b) eq option =
 fun op1 op2 ->
  match (op1, op2) with
  | (Single op1, Single op2) ->
      equal_contents_kind op1 op2
  | (Single _, Cons _) ->
      None
  | (Cons _, Single _) ->
      None
  | (Cons (op1, ops1), Cons (op2, ops2)) -> (
    match equal_contents_kind op1 op2 with
    | None ->
        None
    | Some Eq -> (
      match equal_contents_kind_list ops1 ops2 with
      | None ->
          None
      | Some Eq ->
          Some Eq ) )

let equal : type a b. a operation -> b operation -> (a, b) eq option =
 fun op1 op2 ->
  if not (Operation_hash.equal (hash op1) (hash op2)) then None
  else
    equal_contents_kind_list
      op1.protocol_data.contents
      op2.protocol_data.contents
operation_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module Kind.
  Inductive seed_nonce_revelation : Type :=
  | Seed_nonce_revelation_kind : seed_nonce_revelation.
  
  Inductive double_endorsement_evidence : Type :=
  | Double_endorsement_evidence_kind : double_endorsement_evidence.
  
  Inductive double_baking_evidence : Type :=
  | Double_baking_evidence_kind : double_baking_evidence.
  
  Inductive activate_account : Type :=
  | Activate_account_kind : activate_account.
  
  Inductive endorsement : Type :=
  | Endorsement_kind : endorsement.
  
  Inductive proposals : Type :=
  | Proposals_kind : proposals.
  
  Inductive ballot : Type :=
  | Ballot_kind : ballot.
  
  Inductive reveal : Type :=
  | Reveal_kind : reveal.
  
  Inductive transaction : Type :=
  | Transaction_kind : transaction.
  
  Inductive origination : Type :=
  | Origination_kind : origination.
  
  Inductive delegation : Type :=
  | Delegation_kind : delegation.
  
  Reserved Notation "'manager".
  
  Inductive manager_gadt : Type :=
  | Reveal_manager_kind : manager_gadt
  | Transaction_manager_kind : manager_gadt
  | Origination_manager_kind : manager_gadt
  | Delegation_manager_kind : manager_gadt
  
  where "'manager" := (fun (a : Type) => manager_gadt).
  
  Definition manager := 'manager.
End Kind.

Record raw := {
  shell : Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
  proto : Tezos_protocol_environment_alpha__Environment.MBytes.t }.

Definition raw_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.t
    Tezos_protocol_environment_alpha__Environment.Operation.t :=
  Operation.encoding.

Reserved Notation "'operation".
Reserved Notation "'protocol_data".
Reserved Notation "'contents_list".
Reserved Notation "'contents".
Reserved Notation "'manager_operation".
Reserved Notation "'counter".

Record protocol_data_skeleton {contents signature : Type} := {
  contents : contents;
  signature : signature }.
Arguments protocol_data_skeleton : clear implicits.

Record operation_skeleton {shell protocol_data : Type} := {
  shell : shell;
  protocol_data : protocol_data }.
Arguments operation_skeleton : clear implicits.

Inductive contents_list_gadt : Type :=
| Single : forall {kind : Type}, 'contents kind -> contents_list_gadt
| Cons : forall {kind : Type}, 'contents (Kind.manager kind) ->
  contents_list_gadt -> contents_list_gadt

with contents_gadt : Type :=
| Endorsement : Tezos_raw_protocol_alpha.Raw_level_repr.t -> contents_gadt
| Seed_nonce_revelation : Tezos_raw_protocol_alpha.Raw_level_repr.t ->
  Tezos_raw_protocol_alpha.Seed_repr.nonce -> contents_gadt
| Double_endorsement_evidence : 'operation Kind.endorsement ->
  'operation Kind.endorsement -> contents_gadt
| Double_baking_evidence : Tezos_raw_protocol_alpha.Block_header_repr.t ->
  Tezos_raw_protocol_alpha.Block_header_repr.t -> contents_gadt
| Activate_account :
  Tezos_protocol_environment_alpha__Environment.Ed25519.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Blinded_public_key_hash.activation_code ->
  contents_gadt
| Proposals :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Voting_period_repr.t ->
  list
    Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
  -> contents_gadt
| Ballot :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Voting_period_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
  -> Tezos_raw_protocol_alpha.Vote_repr.ballot -> contents_gadt
| Manager_operation : forall {kind : Type},
  Tezos_protocol_environment_alpha__Environment.Signature.public_key_hash ->
  Tezos_raw_protocol_alpha.Tez_repr.tez -> 'counter -> 'manager_operation kind
  -> Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t -> contents_gadt

with manager_operation_gadt : Type :=
| Reveal : Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t
  -> manager_operation_gadt
| Transaction : Tezos_raw_protocol_alpha.Tez_repr.tez ->
  Tezos_raw_protocol_alpha.Script_repr.lazy_expr -> string ->
  Tezos_raw_protocol_alpha.Contract_repr.contract -> manager_operation_gadt
| Origination :
  option
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Script_repr.t ->
  Tezos_raw_protocol_alpha.Tez_repr.tez ->
  option Tezos_raw_protocol_alpha.Contract_repr.t -> manager_operation_gadt
| Delegation :
  option
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  manager_operation_gadt

where "'operation" := (fun (kind : Type) =>
  operation_skeleton
    Tezos_protocol_environment_alpha__Environment.Operation.shell_header
    ('protocol_data kind))
and "'protocol_data" := (fun (kind : Type) =>
  protocol_data_skeleton ('contents_list kind)
    (option Tezos_protocol_environment_alpha__Environment.Signature.t))
and "'contents_list" := (fun (_ : Type) => contents_list_gadt)
and "'contents" := (fun (_ : Type) => contents_gadt)
and "'manager_operation" := (fun (_ : Type) => manager_operation_gadt)
and "'counter" := (Tezos_protocol_environment_alpha__Environment.Z.t).

Definition operation := 'operation.
Definition protocol_data := 'protocol_data.
Definition contents_list := 'contents_list.
Definition contents := 'contents.
Definition manager_operation := 'manager_operation.
Definition counter := 'counter.

Definition manager_kind {kind : Type}
  (function_parameter : manager_operation kind) : Kind.manager kind :=
  match function_parameter with
  | Reveal _ => Kind.Reveal_manager_kind
  | Transaction _ => Kind.Transaction_manager_kind
  | Origination _ => Kind.Origination_manager_kind
  | Delegation _ => Kind.Delegation_manager_kind
  end.

Record internal_operation {kind : Type} := {
  source : Tezos_raw_protocol_alpha.Contract_repr.contract;
  operation : manager_operation kind;
  nonce : Z }.
Arguments internal_operation : clear implicits.

Reserved Notation "'packed_manager_operation".

Inductive packed_manager_operation_gadt : Type :=
| Manager : forall {kind : Type}, manager_operation kind ->
  packed_manager_operation_gadt

where "'packed_manager_operation" := (packed_manager_operation_gadt).

Definition packed_manager_operation := 'packed_manager_operation.

Reserved Notation "'packed_contents".

Inductive packed_contents_gadt : Type :=
| Contents : forall {kind : Type}, contents kind -> packed_contents_gadt

where "'packed_contents" := (packed_contents_gadt).

Definition packed_contents := 'packed_contents.

Reserved Notation "'packed_contents_list".

Inductive packed_contents_list_gadt : Type :=
| Contents_list : forall {kind : Type}, contents_list kind ->
  packed_contents_list_gadt

where "'packed_contents_list" := (packed_contents_list_gadt).

Definition packed_contents_list := 'packed_contents_list.

Reserved Notation "'packed_protocol_data".

Inductive packed_protocol_data_gadt : Type :=
| Operation_data : forall {kind : Type}, protocol_data kind ->
  packed_protocol_data_gadt

where "'packed_protocol_data" := (packed_protocol_data_gadt).

Definition packed_protocol_data := 'packed_protocol_data.

Record packed_operation := {
  shell : Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
  protocol_data : packed_protocol_data }.

Definition pack {A : Type} (function_parameter : operation A)
  : packed_operation :=
  let '{| shell := shell; protocol_data := protocol_data |} :=
    function_parameter in
  {| shell := shell; protocol_data := Operation_data protocol_data |}.

Reserved Notation "'packed_internal_operation".

Inductive packed_internal_operation_gadt : Type :=
| Internal_operation : forall {kind : Type}, internal_operation kind ->
  packed_internal_operation_gadt

where "'packed_internal_operation" := (packed_internal_operation_gadt).

Definition packed_internal_operation := 'packed_internal_operation.

Fixpoint to_list (function_parameter : packed_contents_list)
  : list packed_contents :=
  match function_parameter with
  | Contents_list (Single o) => cons (Contents o) []
  | Contents_list (Cons o os) => cons (Contents o) (to_list (Contents_list os))
  end.

Fixpoint of_list (function_parameter : list packed_contents)
  : packed_contents_list :=
  match function_parameter with
  | [] =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | cons (Contents o) [] => Contents_list (Single o)
  | cons (Contents o) os =>
    let 'Contents_list os := of_list os in
    match (o, os) with
    | (Manager_operation _, Single (Manager_operation _)) =>
      Contents_list (Cons o os)
    | (Manager_operation _, Cons _ _) => Contents_list (Cons o os)
    | _ =>
      Pervasives.failwith
        "Operation list of length > 1 should only contains manager operations."
          % string
    end
  end.

Module Encoding.
  Import Data_encoding.
  
  Definition case {A B : Type}
    (tag : Tezos_protocol_environment_alpha__Environment.Data_encoding.case_tag)
    (name : string)
    (args :
      Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding A)
    (proj : B -> option A) (inj : A -> B)
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.case B :=
    case (String.capitalize_ascii name) None tag
      (merge_objs (obj1 (req None None "kind" % string (constant name))) args)
      (fun x =>
        match proj x with
        | None => None
        | Some x => Some (tt, x)
        end)
      (fun function_parameter =>
        let '(tt, x) := function_parameter in
        inj x).
  
  Module Manager_operations.
    Reserved Notation "'case".
    
    Inductive case_gadt : Type :=
    | MCase : forall {a kind : Type}, Z -> string ->
      Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
      (packed_manager_operation -> option (manager_operation kind)) ->
      (manager_operation kind -> a) -> (a -> manager_operation kind) ->
      case_gadt
    
    where "'case" := (fun (kind : Type) => case_gadt).
    
    Definition case := 'case.
    
    Definition reveal_case : case Kind.reveal :=
      MCase
        {| tag := 0; name := "reveal" % string;
          encoding :=
            obj1
              (req None None "public_key" % string Signature.Public_key.encoding);
          select :=
            fun function_parameter =>
              match function_parameter with
              | Manager ((Reveal _) as op) => Some op
              | _ => None
              end;
          proj :=
            fun function_parameter =>
              let 'Reveal pkh := function_parameter in
              pkh; inj := fun pkh => Reveal pkh |}.
    
    Definition entrypoint_encoding
      : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
        Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.t) :=
      op_atat
        (def "entrypoint" % string (Some "entrypoint" % string)
          (Some "Named entrypoint to a Michelson smart contract" % string))
        (let builtin_case
          (tag : Z) (name :
          Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
          : Tezos_protocol_environment_alpha__Environment.Data_encoding.case
            Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.t) :=
          Data_encoding.case name None
            (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag tag)
            (constant name)
            (fun n =>
              if
                Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
                  n name then
                Some tt
              else
                None)
            (fun function_parameter =>
              let 'tt := function_parameter in
              name) in
        union None
          (cons (builtin_case 0 "default" % string)
            (cons (builtin_case 1 "root" % string)
              (cons (builtin_case 2 "do" % string)
                (cons (builtin_case 3 "set_delegate" % string)
                  (cons (builtin_case 4 "remove_delegate" % string)
                    (cons
                      (Data_encoding.case "named" % string None
                        (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag
                          255) (Bounded.string 31) (fun s => Some s)
                        (fun s => s)) []))))))).
    
    Definition transaction_case : case Kind.transaction :=
      MCase
        {| tag := 1; name := "transaction" % string;
          encoding :=
            obj3 (req None None "amount" % string Tez_repr.encoding)
              (req None None "destination" % string Contract_repr.encoding)
              (opt None None "parameters" % string
                (obj2 (req None None "entrypoint" % string entrypoint_encoding)
                  (req None None "value" % string Script_repr.lazy_expr_encoding)));
          select :=
            fun function_parameter =>
              match function_parameter with
              | Manager ((Transaction _) as op) => Some op
              | _ => None
              end;
          proj :=
            fun function_parameter =>
              let
                'Transaction {|
                  amount := amount;
                    parameters := parameters;
                    entrypoint := entrypoint;
                    destination := destination
                    |} := function_parameter in
              let parameters :=
                if
                  op_andand (Script_repr.is_unit_parameter parameters)
                    (Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
                      entrypoint "default" % string) then
                  None
                else
                  Some (entrypoint, parameters) in
              (amount, destination, parameters);
          inj :=
            fun function_parameter =>
              let '(amount, destination, parameters) := function_parameter in
              let '(entrypoint, parameters) :=
                match parameters with
                | None => ("default" % string, Script_repr.unit_parameter)
                | Some (entrypoint, value) => (entrypoint, value)
                end in
              Transaction
                {| amount := amount; parameters := parameters;
                  entrypoint := entrypoint; destination := destination |} |}.
    
    Definition origination_case : case Kind.origination :=
      MCase
        {| tag := 2; name := "origination" % string;
          encoding :=
            obj3 (req None None "balance" % string Tez_repr.encoding)
              (opt None None "delegate" % string
                Signature.Public_key_hash.encoding)
              (req None None "script" % string Script_repr.encoding);
          select :=
            fun function_parameter =>
              match function_parameter with
              | Manager ((Origination _) as op) => Some op
              | _ => None
              end;
          proj :=
            fun function_parameter =>
              let
                'Origination {|
                  delegate := delegate;
                    script := script;
                    credit := credit;
                    preorigination := _
                    |} := function_parameter in
              (credit, delegate, script);
          inj :=
            fun function_parameter =>
              let '(credit, delegate, script) := function_parameter in
              Origination
                {| delegate := delegate; script := script; credit := credit;
                  preorigination := None |} |}.
    
    Definition delegation_case : case Kind.delegation :=
      MCase
        {| tag := 3; name := "delegation" % string;
          encoding :=
            obj1
              (opt None None "delegate" % string
                Signature.Public_key_hash.encoding);
          select :=
            fun function_parameter =>
              match function_parameter with
              | Manager ((Delegation _) as op) => Some op
              | _ => None
              end;
          proj :=
            fun function_parameter =>
              let 'Delegation key := function_parameter in
              key; inj := fun key => Delegation key |}.
    
    Definition encoding
      : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
        packed_manager_operation :=
      let make {A : Type} (function_parameter : case A)
        : Tezos_protocol_environment_alpha__Environment.Data_encoding.case
          packed_manager_operation :=
        let
          'MCase {|
            tag := tag;
              name := name;
              encoding := encoding;
              select := select;
              proj := proj;
              inj := inj
              |} := function_parameter in
        case
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag tag)
          name encoding
          (fun o =>
            match select o with
            | None => None
            | Some o => Some (proj o)
            end) (fun x => Manager (inj x)) in
      union
        (Some
          (* ❌ Variants not supported *)
          variant)
        (cons (make reveal_case)
          (cons (make transaction_case)
            (cons (make origination_case) (cons (make delegation_case) [])))).
  End Manager_operations.
  
  Reserved Notation "'case".
  
  Inductive case_gadt : Type :=
  | Case : forall {a b : Type}, Z -> string ->
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
    (packed_contents -> option (contents b)) -> (contents b -> a) ->
    (a -> contents b) -> case_gadt
  
  where "'case" := (fun (b : Type) => case_gadt).
  
  Definition case := 'case.
  
  Definition endorsement_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      Tezos_raw_protocol_alpha.Raw_level_repr.raw_level :=
    obj1 (req None None "level" % string Raw_level_repr.encoding).
  
  Definition endorsement_case : case Kind.endorsement :=
    Case
      {| tag := 0; name := "endorsement" % string;
        encoding := endorsement_encoding;
        select :=
          fun function_parameter =>
            match function_parameter with
            | Contents ((Endorsement _) as op) => Some op
            | _ => None
            end;
        proj :=
          fun function_parameter =>
            let 'Endorsement {| level := level |} := function_parameter in
            level; inj := fun level => Endorsement {| level := level |} |}.
  
  Definition endorsement_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      (operation Kind.endorsement) :=
    let make {A : Type} (function_parameter : case A)
      : Tezos_protocol_environment_alpha__Environment.Data_encoding.case
        (contents A) :=
      let
        'Case {|
          tag := tag;
            name := name;
            encoding := encoding;
            select := _;
            proj := proj;
            inj := inj
            |} := function_parameter in
      case (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag tag)
        name encoding (fun o => Some (proj o)) (fun x => inj x) in
    let to_list (function_parameter : contents_list Kind.endorsement)
      : contents Kind.endorsement :=
      let 'Single o := function_parameter in
      o in
    let of_list (o : contents Kind.endorsement)
      : contents_list Kind.endorsement :=
      Single o in
    op_atat
      (let arg := def "inlined.endorsement" % string in
      fun eta => arg None None eta)
      (conv
        (fun function_parameter =>
          let '{|
            shell := shell;
              protocol_data := {|
                contents := contents;
                  signature := signature
                  |}
              |} := function_parameter in
          (shell, (contents, signature)))
        (fun function_parameter =>
          let '(shell, (contents, signature)) := function_parameter in
          {| shell := shell;
            protocol_data := {| contents := contents; signature := signature |}
            |}) None
        (merge_objs Operation.shell_header_encoding
          (obj2
            (req None None "operations" % string
              (op_atat
                (let arg := conv to_list of_list in
                fun eta => arg None eta)
                (op_atat
                  (let arg := def "inlined.endorsement.contents" % string in
                  fun eta => arg None None eta)
                  (union None (cons (make endorsement_case) [])))))
            (varopt None None "signature" % string Signature.encoding)))).
  
  Definition seed_nonce_revelation_case : case Kind.seed_nonce_revelation :=
    Case
      {| tag := 1; name := "seed_nonce_revelation" % string;
        encoding :=
          obj2 (req None None "level" % string Raw_level_repr.encoding)
            (req None None "nonce" % string Seed_repr.nonce_encoding);
        select :=
          fun function_parameter =>
            match function_parameter with
            | Contents ((Seed_nonce_revelation _) as op) => Some op
            | _ => None
            end;
        proj :=
          fun function_parameter =>
            let 'Seed_nonce_revelation {| level := level; nonce := nonce |} :=
              function_parameter in
            (level, nonce);
        inj :=
          fun function_parameter =>
            let '(level, nonce) := function_parameter in
            Seed_nonce_revelation {| level := level; nonce := nonce |} |}.
  
  Definition double_endorsement_evidence_case
    : case Kind.double_endorsement_evidence :=
    Case
      {| tag := 2; name := "double_endorsement_evidence" % string;
        encoding :=
          obj2
            (req None None "op1" % string
              (dynamic_size None endorsement_encoding))
            (req None None "op2" % string
              (dynamic_size None endorsement_encoding));
        select :=
          fun function_parameter =>
            match function_parameter with
            | Contents ((Double_endorsement_evidence _) as op) => Some op
            | _ => None
            end;
        proj :=
          fun function_parameter =>
            let 'Double_endorsement_evidence {| op1 := op1; op2 := op2 |} :=
              function_parameter in
            (op1, op2);
        inj :=
          fun function_parameter =>
            let '(op1, op2) := function_parameter in
            Double_endorsement_evidence {| op1 := op1; op2 := op2 |} |}.
  
  Definition double_baking_evidence_case : case Kind.double_baking_evidence :=
    Case
      {| tag := 3; name := "double_baking_evidence" % string;
        encoding :=
          obj2
            (req None None "bh1" % string
              (dynamic_size None Block_header_repr.encoding))
            (req None None "bh2" % string
              (dynamic_size None Block_header_repr.encoding));
        select :=
          fun function_parameter =>
            match function_parameter with
            | Contents ((Double_baking_evidence _) as op) => Some op
            | _ => None
            end;
        proj :=
          fun function_parameter =>
            let 'Double_baking_evidence {| bh1 := bh1; bh2 := bh2 |} :=
              function_parameter in
            (bh1, bh2);
        inj :=
          fun function_parameter =>
            let '(bh1, bh2) := function_parameter in
            Double_baking_evidence {| bh1 := bh1; bh2 := bh2 |} |}.
  
  Definition activate_account_case : case Kind.activate_account :=
    Case
      {| tag := 4; name := "activate_account" % string;
        encoding :=
          obj2 (req None None "pkh" % string Ed25519.Public_key_hash.encoding)
            (req None None "secret" % string
              Blinded_public_key_hash.activation_code_encoding);
        select :=
          fun function_parameter =>
            match function_parameter with
            | Contents ((Activate_account _) as op) => Some op
            | _ => None
            end;
        proj :=
          fun function_parameter =>
            let
              'Activate_account {|
                id := id; activation_code := activation_code |} :=
              function_parameter in
            (id, activation_code);
        inj :=
          fun function_parameter =>
            let '(id, activation_code) := function_parameter in
            Activate_account {| id := id; activation_code := activation_code |}
        |}.
  
  Definition proposals_case : case Kind.proposals :=
    Case
      {| tag := 5; name := "proposals" % string;
        encoding :=
          obj3
            (req None None "source" % string Signature.Public_key_hash.encoding)
            (req None None "period" % string Voting_period_repr.encoding)
            (req None None "proposals" % string
              (list None
                Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.encoding)));
        select :=
          fun function_parameter =>
            match function_parameter with
            | Contents ((Proposals _) as op) => Some op
            | _ => None
            end;
        proj :=
          fun function_parameter =>
            let
              'Proposals {|
                source := source;
                  period := period;
                  proposals := proposals
                  |} := function_parameter in
            (source, period, proposals);
        inj :=
          fun function_parameter =>
            let '(source, period, proposals) := function_parameter in
            Proposals
              {| source := source; period := period; proposals := proposals |}
        |}.
  
  Definition ballot_case : case Kind.ballot :=
    Case
      {| tag := 6; name := "ballot" % string;
        encoding :=
          obj4
            (req None None "source" % string Signature.Public_key_hash.encoding)
            (req None None "period" % string Voting_period_repr.encoding)
            (req None None "proposal" % string
              Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.encoding))
            (req None None "ballot" % string Vote_repr.ballot_encoding);
        select :=
          fun function_parameter =>
            match function_parameter with
            | Contents ((Ballot _) as op) => Some op
            | _ => None
            end;
        proj :=
          fun function_parameter =>
            let
              'Ballot {|
                source := source;
                  period := period;
                  proposal := proposal;
                  ballot := ballot
                  |} := function_parameter in
            (source, period, proposal, ballot);
        inj :=
          fun function_parameter =>
            let '(source, period, proposal, ballot) := function_parameter in
            Ballot
              {| source := source; period := period; proposal := proposal;
                ballot := ballot |} |}.
  
  Definition manager_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
        * Tezos_raw_protocol_alpha.Tez_repr.t *
        Tezos_protocol_environment_alpha__Environment.Z.t *
        Tezos_protocol_environment_alpha__Environment.Z.t *
        Tezos_protocol_environment_alpha__Environment.Z.t) :=
    obj5 (req None None "source" % string Signature.Public_key_hash.encoding)
      (req None None "fee" % string Tez_repr.encoding)
      (req None None "counter" % string (check_size 10 n))
      (req None None "gas_limit" % string (check_size 10 n))
      (req None None "storage_limit" % string (check_size 10 n)).
  
  Definition extract {A : Type} (function_parameter : contents (Kind.manager A))
    : Tezos_protocol_environment_alpha__Environment.Signature.public_key_hash *
      Tezos_raw_protocol_alpha.Tez_repr.tez * counter *
      Tezos_protocol_environment_alpha__Environment.Z.t *
      Tezos_protocol_environment_alpha__Environment.Z.t :=
    let
      'Manager_operation {|
        source := source;
          fee := fee;
          counter := counter;
          operation := _;
          gas_limit := gas_limit;
          storage_limit := storage_limit
          |} := function_parameter in
    (source, fee, counter, gas_limit, storage_limit).
  
  Definition rebuild {A : Type}
    (function_parameter :
      Tezos_protocol_environment_alpha__Environment.Signature.public_key_hash *
        Tezos_raw_protocol_alpha.Tez_repr.tez * counter *
        Tezos_protocol_environment_alpha__Environment.Z.t *
        Tezos_protocol_environment_alpha__Environment.Z.t)
    : manager_operation A -> contents (Kind.manager A) :=
    let '(source, fee, counter, gas_limit, storage_limit) := function_parameter
      in
    fun operation =>
      Manager_operation
        {| source := source; fee := fee; counter := counter;
          operation := operation; gas_limit := gas_limit;
          storage_limit := storage_limit |}.
  
  Definition make_manager_case {A : Type}
    (tag : Z) (function_parameter : Manager_operations.case A)
    : case (Kind.manager A) :=
    let 'Manager_operations.MCase mcase := function_parameter in
    Case
      {| tag := tag; name := name mcase;
        encoding := merge_objs manager_encoding (encoding mcase);
        select :=
          fun function_parameter =>
            match function_parameter with
            | Contents (Manager_operation ({| operation := operation |} as op))
              =>
              match (select mcase) (Manager operation) with
              | None => None
              | Some operation =>
                Some
                  (Manager_operation
                    (* ❌ Record substitution not handled *)
                    record_substitution)
              end
            | _ => None
            end;
        proj :=
          fun function_parameter =>
            let '(Manager_operation {| operation := operation |}) as op :=
              function_parameter in
            ((extract op), ((proj mcase) operation));
        inj :=
          fun function_parameter =>
            let '(op, contents) := function_parameter in
            rebuild op ((inj mcase) contents) |}.
  
  Definition reveal_case : case (Kind.manager Kind.reveal) :=
    make_manager_case 107 Manager_operations.reveal_case.
  
  Definition transaction_case : case (Kind.manager Kind.transaction) :=
    make_manager_case 108 Manager_operations.transaction_case.
  
  Definition origination_case : case (Kind.manager Kind.origination) :=
    make_manager_case 109 Manager_operations.origination_case.
  
  Definition delegation_case : case (Kind.manager Kind.delegation) :=
    make_manager_case 110 Manager_operations.delegation_case.
  
  Definition contents_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      packed_contents :=
    let make {A : Type} (function_parameter : case A)
      : Tezos_protocol_environment_alpha__Environment.Data_encoding.case
        packed_contents :=
      let
        'Case {|
          tag := tag;
            name := name;
            encoding := encoding;
            select := select;
            proj := proj;
            inj := inj
            |} := function_parameter in
      case (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag tag)
        name encoding
        (fun o =>
          match select o with
          | None => None
          | Some o => Some (proj o)
          end) (fun x => Contents (inj x)) in
    op_atat
      (let arg := def "operation.alpha.contents" % string in
      fun eta => arg None None eta)
      (union None
        (cons (make endorsement_case)
          (cons (make seed_nonce_revelation_case)
            (cons (make double_endorsement_evidence_case)
              (cons (make double_baking_evidence_case)
                (cons (make activate_account_case)
                  (cons (make proposals_case)
                    (cons (make ballot_case)
                      (cons (make reveal_case)
                        (cons (make transaction_case)
                          (cons (make origination_case)
                            (cons (make delegation_case) [])))))))))))).
  
  Definition contents_list_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      packed_contents_list :=
    conv to_list of_list None (Variable.list None contents_encoding).
  
  Definition optional_signature_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      (option Tezos_protocol_environment_alpha__Environment.Signature.t) :=
    conv
      (fun function_parameter =>
        match function_parameter with
        | Some s => s
        | None => Signature.zero
        end)
      (fun s =>
        if Signature.equal s Signature.zero then
          None
        else
          Some s) None Signature.encoding.
  
  Definition protocol_data_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      packed_protocol_data :=
    op_atat
      (let arg := def "operation.alpha.contents_and_signature" % string in
      fun eta => arg None None eta)
      (conv
        (fun function_parameter =>
          let
            'Operation_data {| contents := contents; signature := signature |} :=
            function_parameter in
          ((Contents_list contents), signature))
        (fun function_parameter =>
          let '(Contents_list contents, signature) := function_parameter in
          Operation_data {| contents := contents; signature := signature |})
        None
        (obj2 (req None None "contents" % string contents_list_encoding)
          (req None None "signature" % string optional_signature_encoding))).
  
  Definition operation_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      packed_operation :=
    conv
      (fun function_parameter =>
        let '{| shell := shell; protocol_data := protocol_data |} :=
          function_parameter in
        (shell, protocol_data))
      (fun function_parameter =>
        let '(shell, protocol_data) := function_parameter in
        {| shell := shell; protocol_data := protocol_data |}) None
      (merge_objs Operation.shell_header_encoding protocol_data_encoding).
  
  Definition unsigned_operation_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      (Tezos_protocol_environment_alpha__Environment.Operation.shell_header *
        packed_contents_list) :=
    op_atat
      (let arg := def "operation.alpha.unsigned_operation" % string in
      fun eta => arg None None eta)
      (merge_objs Operation.shell_header_encoding
        (obj1 (req None None "contents" % string contents_list_encoding))).
  
  Definition internal_operation_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      packed_internal_operation :=
    op_atat
      (let arg := def "operation.alpha.internal_operation" % string in
      fun eta => arg None None eta)
      (conv
        (fun function_parameter =>
          let
            'Internal_operation {|
              source := source; operation := operation; nonce := nonce |} :=
            function_parameter in
          ((source, nonce), (Manager operation)))
        (fun function_parameter =>
          let '((source, nonce), Manager operation) := function_parameter in
          Internal_operation
            {| source := source; operation := operation; nonce := nonce |}) None
        (merge_objs
          (obj2 (req None None "source" % string Contract_repr.encoding)
            (req None None "nonce" % string uint16)) Manager_operations.encoding)).
End Encoding.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    packed_operation := Encoding.operation_encoding.

Definition contents_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    packed_contents := Encoding.contents_encoding.

Definition contents_list_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    packed_contents_list := Encoding.contents_list_encoding.

Definition protocol_data_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    packed_protocol_data := Encoding.protocol_data_encoding.

Definition unsigned_operation_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (Tezos_protocol_environment_alpha__Environment.Operation.shell_header *
      packed_contents_list) := Encoding.unsigned_operation_encoding.

Definition internal_operation_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    packed_internal_operation := Encoding.internal_operation_encoding.

Definition raw {A : Type} (function_parameter : operation A)
  : Tezos_protocol_environment_alpha__Environment.Operation.t :=
  let '{| shell := shell; protocol_data := protocol_data |} :=
    function_parameter in
  let proto :=
    Data_encoding.Binary.to_bytes_exn protocol_data_encoding
      (Operation_data protocol_data) in
  {| Operation.shell := shell; Operation.proto := proto |}.

Definition acceptable_passes (op : packed_operation) : list Z :=
  let 'Operation_data protocol_data := protocol_data op in
  match contents protocol_data with
  | Single (Endorsement _) => cons 0 []
  | Single (Proposals _) => cons 1 []
  | Single (Ballot _) => cons 1 []
  | Single (Seed_nonce_revelation _) => cons 2 []
  | Single (Double_endorsement_evidence _) => cons 2 []
  | Single (Double_baking_evidence _) => cons 2 []
  | Single (Activate_account _) => cons 2 []
  | Single (Manager_operation _) => cons 3 []
  | Cons _ _ => cons 3 []
  end.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "operation.invalid_signature" % string
      "Invalid operation signature" % string
      "The operation signature is ill-formed or has been made with the wrong public key"
        % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "The operation signature is invalid" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "The operation signature is invalid" % string)))
      Data_encoding.unit
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_signature
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_signature)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "operation.missing_signature" % string
    "Missing operation signature" % string
    "The operation is of a kind that must be signed, but the signature is missing"
      % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "The operation requires a signature" % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "The operation requires a signature" % string)))
    Data_encoding.unit
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Missing_signature
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Missing_signature).

Definition check_signature_sync {A : Type}
  (key : Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
  (chain_id :
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (function_parameter : operation A)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
  let '{| shell := shell; protocol_data := protocol_data |} :=
    function_parameter in
  let check
    (watermark :
    Tezos_protocol_environment_alpha__Environment.Signature.watermark) (contents
    : packed_contents_list) (signature :
    Tezos_protocol_environment_alpha__Environment.Signature.t)
    : Tezos_protocol_environment_alpha__Environment.Pervasives.result unit
      (list Tezos_protocol_environment_alpha__Environment.Error_monad.error) :=
    let unsigned_operation :=
      Data_encoding.Binary.to_bytes_exn unsigned_operation_encoding
        (shell, contents) in
    if Signature.check (Some watermark) key signature unsigned_operation then
      Tezos_protocol_environment_alpha__Environment.Pervasives.Ok tt
    else
      error
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_signature
    in
  match ((contents protocol_data), (signature protocol_data)) with
  | (Single _, None) =>
    error
      Tezos_protocol_environment_alpha__Environment.Error_monad.Missing_signature
  | (Cons _ _, None) =>
    error
      Tezos_protocol_environment_alpha__Environment.Error_monad.Missing_signature
  | ((Single (Endorsement _)) as contents, Some signature) =>
    check
      (Tezos_protocol_environment_alpha__Environment.Signature.Endorsement
        chain_id) (Contents_list contents) signature
  | ((Single _) as contents, Some signature) =>
    check
      Tezos_protocol_environment_alpha__Environment.Signature.Generic_operation
      (Contents_list contents) signature
  | ((Cons _ _) as contents, Some signature) =>
    check
      Tezos_protocol_environment_alpha__Environment.Signature.Generic_operation
      (Contents_list contents) signature
  end.

Definition check_signature {A : Type}
  (pk : Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t)
  (chain_id :
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (op : operation A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  Lwt.__return (check_signature_sync pk chain_id op).

Definition hash_raw
  : Tezos_protocol_environment_alpha__Environment.Operation.t ->
    Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t) :=
  Operation.hash.

Definition hash {A : Type} (o : operation A)
  : Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t) :=
  let proto :=
    Data_encoding.Binary.to_bytes_exn protocol_data_encoding
      (Operation_data (protocol_data o)) in
  Operation.hash {| shell := shell o; proto := proto |}.

Definition hash_packed (o : packed_operation)
  : Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t) :=
  let proto :=
    Data_encoding.Binary.to_bytes_exn protocol_data_encoding (protocol_data o)
    in
  Operation.hash {| shell := shell o; proto := proto |}.

Reserved Notation "'eq".

Inductive eq_gadt : Type :=
| Eq : eq_gadt

where "'eq" := (fun (a b : Type) => eq_gadt).

Definition eq := 'eq.

Definition equal_manager_operation_kind {a b : Type}
  (op1 : manager_operation a) (op2 : manager_operation b) : option (eq a b) :=
  match (op1, op2) with
  | (Reveal _, Reveal _) => Some Eq
  | (Reveal _, _) => None
  | (Transaction _, Transaction _) => Some Eq
  | (Transaction _, _) => None
  | (Origination _, Origination _) => Some Eq
  | (Origination _, _) => None
  | (Delegation _, Delegation _) => Some Eq
  | (Delegation _, _) => None
  end.

Definition equal_contents_kind {a b : Type}
  (op1 : contents a) (op2 : contents b) : option (eq a b) :=
  match (op1, op2) with
  | (Endorsement _, Endorsement _) => Some Eq
  | (Endorsement _, _) => None
  | (Seed_nonce_revelation _, Seed_nonce_revelation _) => Some Eq
  | (Seed_nonce_revelation _, _) => None
  | (Double_endorsement_evidence _, Double_endorsement_evidence _) => Some Eq
  | (Double_endorsement_evidence _, _) => None
  | (Double_baking_evidence _, Double_baking_evidence _) => Some Eq
  | (Double_baking_evidence _, _) => None
  | (Activate_account _, Activate_account _) => Some Eq
  | (Activate_account _, _) => None
  | (Proposals _, Proposals _) => Some Eq
  | (Proposals _, _) => None
  | (Ballot _, Ballot _) => Some Eq
  | (Ballot _, _) => None
  | (Manager_operation op1, Manager_operation op2) =>
    match equal_manager_operation_kind (operation op1) (operation op2) with
    | None => None
    | Some Eq => Some Eq
    end
  | (Manager_operation _, _) => None
  end.

Fixpoint equal_contents_kind_list {a b : Type}
  (op1 : contents_list a) (op2 : contents_list b) : option (eq a b) :=
  match (op1, op2) with
  | (Single op1, Single op2) => equal_contents_kind op1 op2
  | (Single _, Cons _ _) => None
  | (Cons _ _, Single _) => None
  | (Cons op1 ops1, Cons op2 ops2) =>
    match equal_contents_kind op1 op2 with
    | None => None
    | Some Eq =>
      match equal_contents_kind_list ops1 ops2 with
      | None => None
      | Some Eq => Some Eq
      end
    end
  end.

Definition equal {a b : Type} (op1 : operation a) (op2 : operation b)
  : option (eq a b) :=
  if
    not
      (Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.equal)
        (hash op1) (hash op2)) then
    None
  else
    equal_contents_kind_list (contents (protocol_data op1))
      (contents (protocol_data op2)).
operation_repr.mli 26 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* Tezos Protocol Implementation - Low level Repr. of Operations *)

module Kind : sig
  type seed_nonce_revelation = Seed_nonce_revelation_kind

  type double_endorsement_evidence = Double_endorsement_evidence_kind

  type double_baking_evidence = Double_baking_evidence_kind

  type activate_account = Activate_account_kind

  type endorsement = Endorsement_kind

  type proposals = Proposals_kind

  type ballot = Ballot_kind

  type reveal = Reveal_kind

  type transaction = Transaction_kind

  type origination = Origination_kind

  type delegation = Delegation_kind

  type 'a manager =
    | Reveal_manager_kind : reveal manager
    | Transaction_manager_kind : transaction manager
    | Origination_manager_kind : origination manager
    | Delegation_manager_kind : delegation manager
end

type raw = Operation.t = {shell : Operation.shell_header; proto : MBytes.t}

val raw_encoding : raw Data_encoding.t

type 'kind operation = {
  shell : Operation.shell_header;
  protocol_data : 'kind protocol_data;
}

and 'kind protocol_data = {
  contents : 'kind contents_list;
  signature : Signature.t option;
}

and _ contents_list =
  | Single : 'kind contents -> 'kind contents_list
  | Cons :
      'kind Kind.manager contents * 'rest Kind.manager contents_list
      -> ('kind * 'rest) Kind.manager contents_list

and _ contents =
  | Endorsement : {level : Raw_level_repr.t} -> Kind.endorsement contents
  | Seed_nonce_revelation : {
      level : Raw_level_repr.t;
      nonce : Seed_repr.nonce;
    }
      -> Kind.seed_nonce_revelation contents
  | Double_endorsement_evidence : {
      op1 : Kind.endorsement operation;
      op2 : Kind.endorsement operation;
    }
      -> Kind.double_endorsement_evidence contents
  | Double_baking_evidence : {
      bh1 : Block_header_repr.t;
      bh2 : Block_header_repr.t;
    }
      -> Kind.double_baking_evidence contents
  | Activate_account : {
      id : Ed25519.Public_key_hash.t;
      activation_code : Blinded_public_key_hash.activation_code;
    }
      -> Kind.activate_account contents
  | Proposals : {
      source : Signature.Public_key_hash.t;
      period : Voting_period_repr.t;
      proposals : Protocol_hash.t list;
    }
      -> Kind.proposals contents
  | Ballot : {
      source : Signature.Public_key_hash.t;
      period : Voting_period_repr.t;
      proposal : Protocol_hash.t;
      ballot : Vote_repr.ballot;
    }
      -> Kind.ballot contents
  | Manager_operation : {
      source : Signature.Public_key_hash.t;
      fee : Tez_repr.tez;
      counter : counter;
      operation : 'kind manager_operation;
      gas_limit : Z.t;
      storage_limit : Z.t;
    }
      -> 'kind Kind.manager contents

and _ manager_operation =
  | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation
  | Transaction : {
      amount : Tez_repr.tez;
      parameters : Script_repr.lazy_expr;
      entrypoint : string;
      destination : Contract_repr.contract;
    }
      -> Kind.transaction manager_operation
  | Origination : {
      delegate : Signature.Public_key_hash.t option;
      script : Script_repr.t;
      credit : Tez_repr.tez;
      preorigination : Contract_repr.t option;
    }
      -> Kind.origination manager_operation
  | Delegation :
      Signature.Public_key_hash.t option
      -> Kind.delegation manager_operation

and counter = Z.t

type 'kind internal_operation = {
  source : Contract_repr.contract;
  operation : 'kind manager_operation;
  nonce : int;
}

type packed_manager_operation =
  | Manager : 'kind manager_operation -> packed_manager_operation

type packed_contents = Contents : 'kind contents -> packed_contents

type packed_contents_list =
  | Contents_list : 'kind contents_list -> packed_contents_list

val of_list : packed_contents list -> packed_contents_list

val to_list : packed_contents_list -> packed_contents list

type packed_protocol_data =
  | Operation_data : 'kind protocol_data -> packed_protocol_data

type packed_operation = {
  shell : Operation.shell_header;
  protocol_data : packed_protocol_data;
}

val pack : 'kind operation -> packed_operation

type packed_internal_operation =
  | Internal_operation : 'kind internal_operation -> packed_internal_operation

val manager_kind : 'kind manager_operation -> 'kind Kind.manager

val encoding : packed_operation Data_encoding.t

val contents_encoding : packed_contents Data_encoding.t

val contents_list_encoding : packed_contents_list Data_encoding.t

val protocol_data_encoding : packed_protocol_data Data_encoding.t

val unsigned_operation_encoding :
  (Operation.shell_header * packed_contents_list) Data_encoding.t

val raw : _ operation -> raw

val hash_raw : raw -> Operation_hash.t

val hash : _ operation -> Operation_hash.t

val hash_packed : packed_operation -> Operation_hash.t

val acceptable_passes : packed_operation -> int list

type error += Missing_signature (* `Permanent *)

type error += Invalid_signature (* `Permanent *)

val check_signature :
  Signature.Public_key.t -> Chain_id.t -> _ operation -> unit tzresult Lwt.t

val check_signature_sync :
  Signature.Public_key.t -> Chain_id.t -> _ operation -> unit tzresult

val internal_operation_encoding : packed_internal_operation Data_encoding.t

type ('a, 'b) eq = Eq : ('a, 'a) eq

val equal : 'a operation -> 'b operation -> ('a, 'b) eq option

module Encoding : sig
  type 'b case =
    | Case : {
        tag : int;
        name : string;
        encoding : 'a Data_encoding.t;
        select : packed_contents -> 'b contents option;
        proj : 'b contents -> 'a;
        inj : 'a -> 'b contents;
      }
        -> 'b case

  val endorsement_case : Kind.endorsement case

  val seed_nonce_revelation_case : Kind.seed_nonce_revelation case

  val double_endorsement_evidence_case : Kind.double_endorsement_evidence case

  val double_baking_evidence_case : Kind.double_baking_evidence case

  val activate_account_case : Kind.activate_account case

  val proposals_case : Kind.proposals case

  val ballot_case : Kind.ballot case

  val reveal_case : Kind.reveal Kind.manager case

  val transaction_case : Kind.transaction Kind.manager case

  val origination_case : Kind.origination Kind.manager case

  val delegation_case : Kind.delegation Kind.manager case

  module Manager_operations : sig
    type 'b case =
      | MCase : {
          tag : int;
          name : string;
          encoding : 'a Data_encoding.t;
          select : packed_manager_operation -> 'kind manager_operation option;
          proj : 'kind manager_operation -> 'a;
          inj : 'a -> 'kind manager_operation;
        }
          -> 'kind case

    val reveal_case : Kind.reveal case

    val transaction_case : Kind.transaction case

    val origination_case : Kind.origination case

    val delegation_case : Kind.delegation case
  end
end
operation_repr_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module Kind.
  Inductive seed_nonce_revelation : Type :=
  | Seed_nonce_revelation_kind : seed_nonce_revelation.
  
  Inductive double_endorsement_evidence : Type :=
  | Double_endorsement_evidence_kind : double_endorsement_evidence.
  
  Inductive double_baking_evidence : Type :=
  | Double_baking_evidence_kind : double_baking_evidence.
  
  Inductive activate_account : Type :=
  | Activate_account_kind : activate_account.
  
  Inductive endorsement : Type :=
  | Endorsement_kind : endorsement.
  
  Inductive proposals : Type :=
  | Proposals_kind : proposals.
  
  Inductive ballot : Type :=
  | Ballot_kind : ballot.
  
  Inductive reveal : Type :=
  | Reveal_kind : reveal.
  
  Inductive transaction : Type :=
  | Transaction_kind : transaction.
  
  Inductive origination : Type :=
  | Origination_kind : origination.
  
  Inductive delegation : Type :=
  | Delegation_kind : delegation.
  
  Reserved Notation "'manager".
  
  Inductive manager_gadt : Type :=
  | Reveal_manager_kind : manager_gadt
  | Transaction_manager_kind : manager_gadt
  | Origination_manager_kind : manager_gadt
  | Delegation_manager_kind : manager_gadt
  
  where "'manager" := (fun (a : Type) => manager_gadt).
  
  Definition manager := 'manager.
End Kind.

Record raw := {
  shell : Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
  proto : Tezos_protocol_environment_alpha__Environment.MBytes.t }.

Parameter raw_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t raw.

Reserved Notation "'operation".
Reserved Notation "'protocol_data".
Reserved Notation "'contents_list".
Reserved Notation "'contents".
Reserved Notation "'manager_operation".
Reserved Notation "'counter".

Record protocol_data_skeleton {contents signature : Type} := {
  contents : contents;
  signature : signature }.
Arguments protocol_data_skeleton : clear implicits.

Record operation_skeleton {shell protocol_data : Type} := {
  shell : shell;
  protocol_data : protocol_data }.
Arguments operation_skeleton : clear implicits.

Inductive contents_list_gadt : Type :=
| Single : forall {kind : Type}, 'contents kind -> contents_list_gadt
| Cons : forall {kind : Type}, 'contents (Kind.manager kind) ->
  contents_list_gadt -> contents_list_gadt

with contents_gadt : Type :=
| Endorsement : Tezos_raw_protocol_alpha.Raw_level_repr.t -> contents_gadt
| Seed_nonce_revelation : Tezos_raw_protocol_alpha.Raw_level_repr.t ->
  Tezos_raw_protocol_alpha.Seed_repr.nonce -> contents_gadt
| Double_endorsement_evidence : 'operation Kind.endorsement ->
  'operation Kind.endorsement -> contents_gadt
| Double_baking_evidence : Tezos_raw_protocol_alpha.Block_header_repr.t ->
  Tezos_raw_protocol_alpha.Block_header_repr.t -> contents_gadt
| Activate_account :
  Tezos_protocol_environment_alpha__Environment.Ed25519.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Blinded_public_key_hash.activation_code ->
  contents_gadt
| Proposals :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Voting_period_repr.t ->
  list
    Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
  -> contents_gadt
| Ballot :
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Voting_period_repr.t ->
  Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
  -> Tezos_raw_protocol_alpha.Vote_repr.ballot -> contents_gadt
| Manager_operation : forall {kind : Type},
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Tez_repr.tez -> 'counter -> 'manager_operation kind
  -> Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_protocol_environment_alpha__Environment.Z.t -> contents_gadt

with manager_operation_gadt : Type :=
| Reveal : Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t
  -> manager_operation_gadt
| Transaction : Tezos_raw_protocol_alpha.Tez_repr.tez ->
  Tezos_raw_protocol_alpha.Script_repr.lazy_expr -> string ->
  Tezos_raw_protocol_alpha.Contract_repr.contract -> manager_operation_gadt
| Origination :
  option
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  Tezos_raw_protocol_alpha.Script_repr.t ->
  Tezos_raw_protocol_alpha.Tez_repr.tez ->
  option Tezos_raw_protocol_alpha.Contract_repr.t -> manager_operation_gadt
| Delegation :
  option
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
  manager_operation_gadt

where "'operation" := (fun (kind : Type) =>
  operation_skeleton
    Tezos_protocol_environment_alpha__Environment.Operation.shell_header
    ('protocol_data kind))
and "'protocol_data" := (fun (kind : Type) =>
  protocol_data_skeleton ('contents_list kind)
    (option Tezos_protocol_environment_alpha__Environment.Signature.t))
and "'contents_list" := (fun (_ : Type) => contents_list_gadt)
and "'contents" := (fun (_ : Type) => contents_gadt)
and "'manager_operation" := (fun (_ : Type) => manager_operation_gadt)
and "'counter" := (Tezos_protocol_environment_alpha__Environment.Z.t).

Definition operation := 'operation.
Definition protocol_data := 'protocol_data.
Definition contents_list := 'contents_list.
Definition contents := 'contents.
Definition manager_operation := 'manager_operation.
Definition counter := 'counter.

Record internal_operation {kind : Type} := {
  source : Tezos_raw_protocol_alpha.Contract_repr.contract;
  operation : manager_operation kind;
  nonce : Z }.
Arguments internal_operation : clear implicits.

Reserved Notation "'packed_manager_operation".

Inductive packed_manager_operation_gadt : Type :=
| Manager : forall {kind : Type}, manager_operation kind ->
  packed_manager_operation_gadt

where "'packed_manager_operation" := (packed_manager_operation_gadt).

Definition packed_manager_operation := 'packed_manager_operation.

Reserved Notation "'packed_contents".

Inductive packed_contents_gadt : Type :=
| Contents : forall {kind : Type}, contents kind -> packed_contents_gadt

where "'packed_contents" := (packed_contents_gadt).

Definition packed_contents := 'packed_contents.

Reserved Notation "'packed_contents_list".

Inductive packed_contents_list_gadt : Type :=
| Contents_list : forall {kind : Type}, contents_list kind ->
  packed_contents_list_gadt

where "'packed_contents_list" := (packed_contents_list_gadt).

Definition packed_contents_list := 'packed_contents_list.

Parameter of_list : list packed_contents -> packed_contents_list.

Parameter to_list : packed_contents_list -> list packed_contents.

Reserved Notation "'packed_protocol_data".

Inductive packed_protocol_data_gadt : Type :=
| Operation_data : forall {kind : Type}, protocol_data kind ->
  packed_protocol_data_gadt

where "'packed_protocol_data" := (packed_protocol_data_gadt).

Definition packed_protocol_data := 'packed_protocol_data.

Record packed_operation := {
  shell : Tezos_protocol_environment_alpha__Environment.Operation.shell_header;
  protocol_data : packed_protocol_data }.

Parameter pack : forall {kind : Type}, operation kind -> packed_operation.

Reserved Notation "'packed_internal_operation".

Inductive packed_internal_operation_gadt : Type :=
| Internal_operation : forall {kind : Type}, internal_operation kind ->
  packed_internal_operation_gadt

where "'packed_internal_operation" := (packed_internal_operation_gadt).

Definition packed_internal_operation := 'packed_internal_operation.

Parameter manager_kind : forall {kind : Type},
manager_operation kind -> Kind.manager kind.

Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t packed_operation.

Parameter contents_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t packed_contents.

Parameter contents_list_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
  packed_contents_list.

Parameter protocol_data_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
  packed_protocol_data.

Parameter unsigned_operation_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
  (Tezos_protocol_environment_alpha__Environment.Operation.shell_header *
    packed_contents_list).

Parameter raw : forall {_ : Type}, operation _ -> raw.

Parameter hash_raw :
raw ->
  Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t).

Parameter hash : forall {_ : Type},
operation _ ->
  Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t).

Parameter hash_packed :
packed_operation ->
  Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t).

Parameter acceptable_passes : packed_operation -> list Z.

extensible_type

extensible_type

Parameter check_signature : forall {_ : Type},
Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t ->
  Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
    ->
    operation _ ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).

Parameter check_signature_sync : forall {_ : Type},
Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t ->
  Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
    ->
    operation _ ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.

Parameter internal_operation_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
  packed_internal_operation.

Reserved Notation "'eq".

Inductive eq_gadt : Type :=
| Eq : eq_gadt

where "'eq" := (fun (a b : Type) => eq_gadt).

Definition eq := 'eq.

Parameter equal : forall {a b : Type},
operation a -> operation b -> option (eq a b).

Module Encoding.
  Reserved Notation "'case".
  
  Inductive case_gadt : Type :=
  | Case : forall {a b : Type}, Z -> string ->
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
    (packed_contents -> option (contents b)) -> (contents b -> a) ->
    (a -> contents b) -> case_gadt
  
  where "'case" := (fun (b : Type) => case_gadt).
  
  Definition case := 'case.
  
  Parameter endorsement_case : case Kind.endorsement.
  
  Parameter seed_nonce_revelation_case : case Kind.seed_nonce_revelation.
  
  Parameter double_endorsement_evidence_case : case
    Kind.double_endorsement_evidence.
  
  Parameter double_baking_evidence_case : case Kind.double_baking_evidence.
  
  Parameter activate_account_case : case Kind.activate_account.
  
  Parameter proposals_case : case Kind.proposals.
  
  Parameter ballot_case : case Kind.ballot.
  
  Parameter reveal_case : case (Kind.manager Kind.reveal).
  
  Parameter transaction_case : case (Kind.manager Kind.transaction).
  
  Parameter origination_case : case (Kind.manager Kind.origination).
  
  Parameter delegation_case : case (Kind.manager Kind.delegation).
  
  Module Manager_operations.
    Reserved Notation "'case".
    
    Inductive case_gadt : Type :=
    | MCase : forall {a kind : Type}, Z -> string ->
      Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
      (packed_manager_operation -> option (manager_operation kind)) ->
      (manager_operation kind -> a) -> (a -> manager_operation kind) ->
      case_gadt
    
    where "'case" := (fun (b : Type) => case_gadt).
    
    Definition case := 'case.
    
    Parameter reveal_case : case Kind.reveal.
    
    Parameter transaction_case : case Kind.transaction.
    
    Parameter origination_case : case Kind.origination.
    
    Parameter delegation_case : case Kind.delegation.
  End Manager_operations.
End Encoding.
parameters_repr.ml 3 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type bootstrap_account = {
  public_key_hash : Signature.Public_key_hash.t;
  public_key : Signature.Public_key.t option;
  amount : Tez_repr.t;
}

type bootstrap_contract = {
  delegate : Signature.Public_key_hash.t;
  amount : Tez_repr.t;
  script : Script_repr.t;
}

type t = {
  bootstrap_accounts : bootstrap_account list;
  bootstrap_contracts : bootstrap_contract list;
  commitments : Commitment_repr.t list;
  constants : Constants_repr.parametric;
  security_deposit_ramp_up_cycles : int option;
  no_reward_cycles : int option;
}

let bootstrap_account_encoding =
  let open Data_encoding in
  union
    [ case
        (Tag 0)
        ~title:"Public_key_known"
        (tup2 Signature.Public_key.encoding Tez_repr.encoding)
        (function
          | {public_key_hash; public_key = Some public_key; amount} ->
              assert (
                Signature.Public_key_hash.equal
                  (Signature.Public_key.hash public_key)
                  public_key_hash ) ;
              Some (public_key, amount)
          | {public_key = None} ->
              None)
        (fun (public_key, amount) ->
          {
            public_key = Some public_key;
            public_key_hash = Signature.Public_key.hash public_key;
            amount;
          });
      case
        (Tag 1)
        ~title:"Public_key_unknown"
        (tup2 Signature.Public_key_hash.encoding Tez_repr.encoding)
        (function
          | {public_key_hash; public_key = None; amount} ->
              Some (public_key_hash, amount)
          | {public_key = Some _} ->
              None)
        (fun (public_key_hash, amount) ->
          {public_key = None; public_key_hash; amount}) ]

let bootstrap_contract_encoding =
  let open Data_encoding in
  conv
    (fun {delegate; amount; script} -> (delegate, amount, script))
    (fun (delegate, amount, script) -> {delegate; amount; script})
    (obj3
       (req "delegate" Signature.Public_key_hash.encoding)
       (req "amount" Tez_repr.encoding)
       (req "script" Script_repr.encoding))

let encoding =
  let open Data_encoding in
  conv
    (fun { bootstrap_accounts;
           bootstrap_contracts;
           commitments;
           constants;
           security_deposit_ramp_up_cycles;
           no_reward_cycles } ->
      ( ( bootstrap_accounts,
          bootstrap_contracts,
          commitments,
          security_deposit_ramp_up_cycles,
          no_reward_cycles ),
        constants ))
    (fun ( ( bootstrap_accounts,
             bootstrap_contracts,
             commitments,
             security_deposit_ramp_up_cycles,
             no_reward_cycles ),
           constants ) ->
      {
        bootstrap_accounts;
        bootstrap_contracts;
        commitments;
        constants;
        security_deposit_ramp_up_cycles;
        no_reward_cycles;
      })
    (merge_objs
       (obj5
          (req "bootstrap_accounts" (list bootstrap_account_encoding))
          (dft "bootstrap_contracts" (list bootstrap_contract_encoding) [])
          (dft "commitments" (list Commitment_repr.encoding) [])
          (opt "security_deposit_ramp_up_cycles" int31)
          (opt "no_reward_cycles" int31))
       Constants_repr.parametric_encoding)
parameters_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Record bootstrap_account := {
  public_key_hash :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
  public_key :
    option Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t;
  amount : Tezos_raw_protocol_alpha.Tez_repr.t }.

Record bootstrap_contract := {
  delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
  amount : Tezos_raw_protocol_alpha.Tez_repr.t;
  script : Tezos_raw_protocol_alpha.Script_repr.t }.

Record t := {
  bootstrap_accounts : list bootstrap_account;
  bootstrap_contracts : list bootstrap_contract;
  commitments : list Tezos_raw_protocol_alpha.Commitment_repr.t;
  constants : Tezos_raw_protocol_alpha.Constants_repr.parametric;
  security_deposit_ramp_up_cycles : option Z;
  no_reward_cycles : option Z }.

Definition bootstrap_account_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    bootstrap_account :=
  union None
    (cons
      (case "Public_key_known" % string None
        (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
        (tup2 Signature.Public_key.encoding Tez_repr.encoding)
        (fun function_parameter =>
          match function_parameter with
          | {|
            public_key_hash := public_key_hash;
              public_key := Some public_key;
              amount := amount
              |} =>
            (* ❌ Sequences of instructions are not handled (operator ";") *)
            let _ :=
              (* ❌ Assert instruction is not handled. *)
              assert
                (Signature.Public_key_hash.equal
                  (Signature.Public_key.hash public_key) public_key_hash) in
            Some (public_key, amount)
          | {| public_key := None |} => None
          end)
        (fun function_parameter =>
          let '(public_key, amount) := function_parameter in
          {| public_key_hash := Signature.Public_key.hash public_key;
            public_key := Some public_key; amount := amount |}))
      (cons
        (case "Public_key_unknown" % string None
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
          (tup2 Signature.Public_key_hash.encoding Tez_repr.encoding)
          (fun function_parameter =>
            match function_parameter with
            | {|
              public_key_hash := public_key_hash;
                public_key := None;
                amount := amount
                |} => Some (public_key_hash, amount)
            | {| public_key := Some _ |} => None
            end)
          (fun function_parameter =>
            let '(public_key_hash, amount) := function_parameter in
            {| public_key_hash := public_key_hash; public_key := None;
              amount := amount |})) [])).

Definition bootstrap_contract_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    bootstrap_contract :=
  conv
    (fun function_parameter =>
      let '{| delegate := delegate; amount := amount; script := script |} :=
        function_parameter in
      (delegate, amount, script))
    (fun function_parameter =>
      let '(delegate, amount, script) := function_parameter in
      {| delegate := delegate; amount := amount; script := script |}) None
    (obj3 (req None None "delegate" % string Signature.Public_key_hash.encoding)
      (req None None "amount" % string Tez_repr.encoding)
      (req None None "script" % string Script_repr.encoding)).

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
  conv
    (fun function_parameter =>
      let '{|
        bootstrap_accounts := bootstrap_accounts;
          bootstrap_contracts := bootstrap_contracts;
          commitments := commitments;
          constants := constants;
          security_deposit_ramp_up_cycles := security_deposit_ramp_up_cycles;
          no_reward_cycles := no_reward_cycles
          |} := function_parameter in
      ((bootstrap_accounts, bootstrap_contracts, commitments,
        security_deposit_ramp_up_cycles, no_reward_cycles), constants))
    (fun function_parameter =>
      let
        '((bootstrap_accounts, bootstrap_contracts, commitments,
          security_deposit_ramp_up_cycles, no_reward_cycles), constants) :=
        function_parameter in
      {| bootstrap_accounts := bootstrap_accounts;
        bootstrap_contracts := bootstrap_contracts; commitments := commitments;
        constants := constants;
        security_deposit_ramp_up_cycles := security_deposit_ramp_up_cycles;
        no_reward_cycles := no_reward_cycles |}) None
    (merge_objs
      (obj5
        (req None None "bootstrap_accounts" % string
          (list None bootstrap_account_encoding))
        (dft None None "bootstrap_contracts" % string
          (list None bootstrap_contract_encoding) [])
        (dft None None "commitments" % string
          (list None Commitment_repr.encoding) [])
        (opt None None "security_deposit_ramp_up_cycles" % string int31)
        (opt None None "no_reward_cycles" % string int31))
      Constants_repr.parametric_encoding).
parameters_repr.mli 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type bootstrap_account = {
  public_key_hash : Signature.Public_key_hash.t;
  public_key : Signature.Public_key.t option;
  amount : Tez_repr.t;
}

type bootstrap_contract = {
  delegate : Signature.Public_key_hash.t;
  amount : Tez_repr.t;
  script : Script_repr.t;
}

type t = {
  bootstrap_accounts : bootstrap_account list;
  bootstrap_contracts : bootstrap_contract list;
  commitments : Commitment_repr.t list;
  constants : Constants_repr.parametric;
  security_deposit_ramp_up_cycles : int option;
  no_reward_cycles : int option;
}

val encoding : t Data_encoding.t
parameters_repr_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Record bootstrap_account := {
  public_key_hash :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
  public_key :
    option Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t;
  amount : Tezos_raw_protocol_alpha.Tez_repr.t }.

Record bootstrap_contract := {
  delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
  amount : Tezos_raw_protocol_alpha.Tez_repr.t;
  script : Tezos_raw_protocol_alpha.Script_repr.t }.

Record t := {
  bootstrap_accounts : list bootstrap_account;
  bootstrap_contracts : list bootstrap_contract;
  commitments : list Tezos_raw_protocol_alpha.Commitment_repr.t;
  constants : Tezos_raw_protocol_alpha.Constants_repr.parametric;
  security_deposit_ramp_up_cycles : option Z;
  no_reward_cycles : option Z }.

Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t t.
period_repr.ml 17 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = Int64.t

type period = t

include (Compare.Int64 : Compare.S with type t := t)

let encoding = Data_encoding.int64

let rpc_arg = RPC_arg.int64

let pp ppf v = Format.fprintf ppf "%Ld" v

type error += (* `Permanent *)
                Malformed_period | Invalid_arg

let () =
  let open Data_encoding in
  (* Malformed period *)
  register_error_kind
    `Permanent
    ~id:"malformed_period"
    ~title:"Malformed period"
    ~description:"Period is negative."
    ~pp:(fun ppf () -> Format.fprintf ppf "Malformed period")
    empty
    (function Malformed_period -> Some () | _ -> None)
    (fun () -> Malformed_period) ;
  (* Invalid arg *)
  register_error_kind
    `Permanent
    ~id:"invalid_arg"
    ~title:"Invalid arg"
    ~description:"Negative multiple of periods are not allowed."
    ~pp:(fun ppf () -> Format.fprintf ppf "Invalid arg")
    empty
    (function Invalid_arg -> Some () | _ -> None)
    (fun () -> Invalid_arg)

let of_seconds t =
  if Compare.Int64.(t >= 0L) then ok t else error Malformed_period

let to_seconds t = t

let of_seconds_exn t =
  match of_seconds t with
  | Ok t ->
      t
  | _ ->
      invalid_arg "Period.of_seconds_exn"

let mult i p =
  (* TODO check overflow *)
  if Compare.Int32.(i < 0l) then error Invalid_arg
  else ok (Int64.mul (Int64.of_int32 i) p)

let zero = of_seconds_exn 0L

let one_second = of_seconds_exn 1L

let one_minute = of_seconds_exn 60L

let one_hour = of_seconds_exn 3600L
period_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition t := Tezos_protocol_environment_alpha__Environment.Int64.t.

Definition period := t.

Export Compare.Int64.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding int64 :=
  Data_encoding.int64.

Definition rpc_arg
  : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg int64 :=
  RPC_arg.int64.

Definition pp
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (v : int64) : unit :=
  Format.fprintf ppf
    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int64
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
      "%Ld" % string) v.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "malformed_period" % string "Malformed period" % string
      "Period is negative." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Malformed period" % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Malformed period" % string))) empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Malformed_period
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Malformed_period)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "invalid_arg" % string "Invalid arg" % string
    "Negative multiple of periods are not allowed." % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "Invalid arg" % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "Invalid arg" % string))) empty
    (fun function_parameter =>
      match function_parameter with
      | Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arg =>
        Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arg).

Definition of_seconds
  (t :
    Tezos_protocol_environment_alpha__Environment.Compare.Int64.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    Tezos_protocol_environment_alpha__Environment.Compare.Int64.(Tezos_protocol_environment_alpha__Environment.S.Compare.t) :=
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Int64.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
      t
      (* ❌ Constant of type int64 is converted to int *)
      0 then
    ok t
  else
    error
      Tezos_protocol_environment_alpha__Environment.Error_monad.Malformed_period.

Definition to_seconds {A : Type} (t : A) : A := t.

Definition of_seconds_exn
  (t :
    Tezos_protocol_environment_alpha__Environment.Compare.Int64.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : Tezos_protocol_environment_alpha__Environment.Compare.Int64.(Tezos_protocol_environment_alpha__Environment.S.Compare.t) :=
  match of_seconds t with
  | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok t => t
  | _ => invalid_arg "Period.of_seconds_exn" % string
  end.

Definition mult
  (i :
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  (p : int64)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int64 :=
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
      i
      (* ❌ Constant of type int32 is converted to int *)
      0 then
    error Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arg
  else
    ok (Int64.mul (Int64.of_int32 i) p).

Definition zero
  : Tezos_protocol_environment_alpha__Environment.Compare.Int64.(Tezos_protocol_environment_alpha__Environment.S.Compare.t) :=
  of_seconds_exn
    (* ❌ Constant of type int64 is converted to int *)
    0.

Definition one_second
  : Tezos_protocol_environment_alpha__Environment.Compare.Int64.(Tezos_protocol_environment_alpha__Environment.S.Compare.t) :=
  of_seconds_exn
    (* ❌ Constant of type int64 is converted to int *)
    1.

Definition one_minute
  : Tezos_protocol_environment_alpha__Environment.Compare.Int64.(Tezos_protocol_environment_alpha__Environment.S.Compare.t) :=
  of_seconds_exn
    (* ❌ Constant of type int64 is converted to int *)
    60.

Definition one_hour
  : Tezos_protocol_environment_alpha__Environment.Compare.Int64.(Tezos_protocol_environment_alpha__Environment.S.Compare.t) :=
  of_seconds_exn
    (* ❌ Constant of type int64 is converted to int *)
    3600.
period_repr.mli 2 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t

type period = t

include Compare.S with type t := t

val encoding : period Data_encoding.t

val rpc_arg : period RPC_arg.t

val pp : Format.formatter -> period -> unit

val to_seconds : period -> int64

(** [of_second period] fails if period is not positive *)
val of_seconds : int64 -> period tzresult

(** [of_second period] fails if period is not positive.
    It should only be used at toplevel for constants. *)
val of_seconds_exn : int64 -> period

val mult : int32 -> period -> period tzresult

val zero : period

val one_second : period

val one_minute : period

val one_hour : period
period_repr_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter t : Type.

Definition period := t.

include

Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t period.

Parameter rpc_arg :
Tezos_protocol_environment_alpha__Environment.RPC_arg.t period.

Parameter pp :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> period -> unit.

Parameter to_seconds : period -> int64.

Parameter of_seconds :
int64 ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult period.

Parameter of_seconds_exn : int64 -> period.

Parameter mult :
int32 ->
  period ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult period.

Parameter zero : period.

Parameter one_second : period.

Parameter one_minute : period.

Parameter one_hour : period.
qty_repr.ml 8 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

module type QTY = sig
  val id : string
end

module type S = sig
  type qty

  type error +=
    | Addition_overflow of qty * qty (* `Temporary *)
    | Subtraction_underflow of qty * qty (* `Temporary *)
    | Multiplication_overflow of qty * int64 (* `Temporary *)
    | Negative_multiplicator of qty * int64 (* `Temporary *)
    | Invalid_divisor of qty * int64

  (* `Temporary *)

  val id : string

  val zero : qty

  val one_mutez : qty

  val one_cent : qty

  val fifty_cents : qty

  val one : qty

  val ( -? ) : qty -> qty -> qty tzresult

  val ( +? ) : qty -> qty -> qty tzresult

  val ( *? ) : qty -> int64 -> qty tzresult

  val ( /? ) : qty -> int64 -> qty tzresult

  val to_mutez : qty -> int64

  (** [of_mutez n] (micro tez) is None if n is negative *)
  val of_mutez : int64 -> qty option

  (** [of_mutez_exn n] fails if n is negative.
      It should only be used at toplevel for constants. *)
  val of_mutez_exn : int64 -> qty

  (** It should only be used at toplevel for constants. *)
  val add_exn : qty -> qty -> qty

  (** It should only be used at toplevel for constants. *)
  val mul_exn : qty -> int -> qty

  val encoding : qty Data_encoding.t

  val to_int64 : qty -> int64

  include Compare.S with type t := qty

  val pp : Format.formatter -> qty -> unit

  val of_string : string -> qty option

  val to_string : qty -> string
end

module Make (T : QTY) : S = struct
  type qty = int64 (* invariant: positive *)

  type error +=
    | Addition_overflow of qty * qty (* `Temporary *)
    | Subtraction_underflow of qty * qty (* `Temporary *)
    | Multiplication_overflow of qty * int64 (* `Temporary *)
    | Negative_multiplicator of qty * int64 (* `Temporary *)
    | Invalid_divisor of qty * int64

  (* `Temporary *)

  include Compare.Int64

  let zero = 0L

  (* all other constant are defined from the value of one micro tez *)
  let one_mutez = 1L

  let one_cent = Int64.mul one_mutez 10_000L

  let fifty_cents = Int64.mul one_cent 50L

  (* 1 tez = 100 cents = 1_000_000 mutez *)
  let one = Int64.mul one_cent 100L

  let id = T.id

  let of_string s =
    let triplets = function
      | hd :: tl ->
          let len = String.length hd in
          Compare.Int.(
            len <= 3 && len > 0
            && List.for_all (fun s -> String.length s = 3) tl)
      | [] ->
          false
    in
    let integers s = triplets (String.split_on_char ',' s) in
    let decimals s =
      let l = String.split_on_char ',' s in
      if Compare.Int.(List.length l > 2) then false else triplets (List.rev l)
    in
    let parse left right =
      let remove_commas s = String.concat "" (String.split_on_char ',' s) in
      let pad_to_six s =
        let len = String.length s in
        String.init 6 (fun i -> if Compare.Int.(i < len) then s.[i] else '0')
      in
      try
        Some
          (Int64.of_string
             (remove_commas left ^ pad_to_six (remove_commas right)))
      with _ -> None
    in
    match String.split_on_char '.' s with
    | [left; right] ->
        if String.contains s ',' then
          if integers left && decimals right then parse left right else None
        else if
          Compare.Int.(String.length right > 0)
          && Compare.Int.(String.length right <= 6)
        then parse left right
        else None
    | [left] ->
        if (not (String.contains s ',')) || integers left then parse left ""
        else None
    | _ ->
        None

  let pp ppf amount =
    let mult_int = 1_000_000L in
    let rec left ppf amount =
      let (d, r) = (Int64.(div amount 1000L), Int64.(rem amount 1000L)) in
      if d > 0L then Format.fprintf ppf "%a%03Ld" left d r
      else Format.fprintf ppf "%Ld" r
    in
    let right ppf amount =
      let triplet ppf v =
        if Compare.Int.(v mod 10 > 0) then Format.fprintf ppf "%03d" v
        else if Compare.Int.(v mod 100 > 0) then
          Format.fprintf ppf "%02d" (v / 10)
        else Format.fprintf ppf "%d" (v / 100)
      in
      let (hi, lo) = (amount / 1000, amount mod 1000) in
      if Compare.Int.(lo = 0) then Format.fprintf ppf "%a" triplet hi
      else Format.fprintf ppf "%03d%a" hi triplet lo
    in
    let (ints, decs) =
      (Int64.(div amount mult_int), Int64.(to_int (rem amount mult_int)))
    in
    Format.fprintf ppf "%a" left ints ;
    if Compare.Int.(decs > 0) then Format.fprintf ppf ".%a" right decs

  let to_string t = Format.asprintf "%a" pp t

  let ( - ) t1 t2 = if t2 <= t1 then Some (Int64.sub t1 t2) else None

  let ( -? ) t1 t2 =
    match t1 - t2 with
    | None ->
        error (Subtraction_underflow (t1, t2))
    | Some v ->
        ok v

  let ( +? ) t1 t2 =
    let t = Int64.add t1 t2 in
    if t < t1 then error (Addition_overflow (t1, t2)) else ok t

  let ( *? ) t m =
    let open Compare.Int64 in
    let open Int64 in
    let rec step cur pow acc =
      if cur = 0L then ok acc
      else
        pow +? pow
        >>? fun npow ->
        if logand cur 1L = 1L then
          acc +? pow >>? fun nacc -> step (shift_right_logical cur 1) npow nacc
        else step (shift_right_logical cur 1) npow acc
    in
    if m < 0L then error (Negative_multiplicator (t, m))
    else
      match step m t 0L with
      | Ok res ->
          Ok res
      | Error ([Addition_overflow _] as errs) ->
          Error (Multiplication_overflow (t, m) :: errs)
      | Error errs ->
          Error errs

  let ( /? ) t d =
    if d <= 0L then error (Invalid_divisor (t, d)) else ok (Int64.div t d)

  let add_exn t1 t2 =
    let t = Int64.add t1 t2 in
    if t <= 0L then invalid_arg "add_exn" else t

  let mul_exn t m =
    match t *? Int64.(of_int m) with
    | Ok v ->
        v
    | Error _ ->
        invalid_arg "mul_exn"

  let of_mutez t = if t < 0L then None else Some t

  let of_mutez_exn x =
    match of_mutez x with None -> invalid_arg "Qty.of_mutez" | Some v -> v

  let to_int64 t = t

  let to_mutez t = t

  let encoding =
    let open Data_encoding in
    check_size 10 (conv Z.of_int64 (Json.wrap_error Z.to_int64) n)

  let () =
    let open Data_encoding in
    register_error_kind
      `Temporary
      ~id:(T.id ^ ".addition_overflow")
      ~title:("Overflowing " ^ T.id ^ " addition")
      ~pp:(fun ppf (opa, opb) ->
        Format.fprintf
          ppf
          "Overflowing addition of %a %s and %a %s"
          pp
          opa
          T.id
          pp
          opb
          T.id)
      ~description:("An addition of two " ^ T.id ^ " amounts overflowed")
      (obj1 (req "amounts" (tup2 encoding encoding)))
      (function Addition_overflow (a, b) -> Some (a, b) | _ -> None)
      (fun (a, b) -> Addition_overflow (a, b)) ;
    register_error_kind
      `Temporary
      ~id:(T.id ^ ".subtraction_underflow")
      ~title:("Underflowing " ^ T.id ^ " subtraction")
      ~pp:(fun ppf (opa, opb) ->
        Format.fprintf
          ppf
          "Underflowing subtraction of %a %s and %a %s"
          pp
          opa
          T.id
          pp
          opb
          T.id)
      ~description:("An subtraction of two " ^ T.id ^ " amounts underflowed")
      (obj1 (req "amounts" (tup2 encoding encoding)))
      (function Subtraction_underflow (a, b) -> Some (a, b) | _ -> None)
      (fun (a, b) -> Subtraction_underflow (a, b)) ;
    register_error_kind
      `Temporary
      ~id:(T.id ^ ".multiplication_overflow")
      ~title:("Overflowing " ^ T.id ^ " multiplication")
      ~pp:(fun ppf (opa, opb) ->
        Format.fprintf
          ppf
          "Overflowing multiplication of %a %s and %Ld"
          pp
          opa
          T.id
          opb)
      ~description:
        ("A multiplication of a " ^ T.id ^ " amount by an integer overflowed")
      (obj2 (req "amount" encoding) (req "multiplicator" int64))
      (function Multiplication_overflow (a, b) -> Some (a, b) | _ -> None)
      (fun (a, b) -> Multiplication_overflow (a, b)) ;
    register_error_kind
      `Temporary
      ~id:(T.id ^ ".negative_multiplicator")
      ~title:("Negative " ^ T.id ^ " multiplicator")
      ~pp:(fun ppf (opa, opb) ->
        Format.fprintf
          ppf
          "Multiplication of %a %s by negative integer %Ld"
          pp
          opa
          T.id
          opb)
      ~description:
        ("Multiplication of a " ^ T.id ^ " amount by a negative integer")
      (obj2 (req "amount" encoding) (req "multiplicator" int64))
      (function Negative_multiplicator (a, b) -> Some (a, b) | _ -> None)
      (fun (a, b) -> Negative_multiplicator (a, b)) ;
    register_error_kind
      `Temporary
      ~id:(T.id ^ ".invalid_divisor")
      ~title:("Invalid " ^ T.id ^ " divisor")
      ~pp:(fun ppf (opa, opb) ->
        Format.fprintf
          ppf
          "Division of %a %s by non positive integer %Ld"
          pp
          opa
          T.id
          opb)
      ~description:
        ("Multiplication of a " ^ T.id ^ " amount by a non positive integer")
      (obj2 (req "amount" encoding) (req "divisor" int64))
      (function Invalid_divisor (a, b) -> Some (a, b) | _ -> None)
      (fun (a, b) -> Invalid_divisor (a, b))
end
qty_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module QTY.
  Record signature := {
    id : string;
  }.
End QTY.

Module S.
  Record signature {qty : Type} := {
    qty := qty;
    extensible_type;
    id : string;
    zero : qty;
    one_mutez : qty;
    one_cent : qty;
    fifty_cents : qty;
    one : qty;
    op_minusquestion : qty ->
      qty ->
        Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult qty;
    op_plusquestion : qty ->
      qty ->
        Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult qty;
    op_starquestion : qty ->
      int64 ->
        Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult qty;
    op_divquestion : qty ->
      int64 ->
        Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult qty;
    to_mutez : qty -> int64;
    of_mutez : int64 -> option qty;
    of_mutez_exn : int64 -> qty;
    add_exn : qty -> qty -> qty;
    mul_exn : qty -> Z -> qty;
    encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t qty;
    to_int64 : qty -> int64;
    op_eq : qty -> qty -> bool;
    op_ltgt : qty -> qty -> bool;
    op_lt : qty -> qty -> bool;
    op_lteq : qty -> qty -> bool;
    op_gteq : qty -> qty -> bool;
    op_gt : qty -> qty -> bool;
    compare : qty -> qty -> Z;
    equal : qty -> qty -> bool;
    max : qty -> qty -> qty;
    min : qty -> qty -> qty;
    pp : Tezos_protocol_environment_alpha__Environment.Format.formatter ->
      qty -> unit;
    of_string : string -> option qty;
    to_string : qty -> string;
  }.
  Arguments signature : clear implicits.
End S.

(* ❌ Functors are not handled. *)
functor
raw_context.ml 92 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

module Int_set = Set.Make (Compare.Int)

type t = {
  context : Context.t;
  constants : Constants_repr.parametric;
  first_level : Raw_level_repr.t;
  level : Level_repr.t;
  predecessor_timestamp : Time.t;
  timestamp : Time.t;
  fitness : Int64.t;
  deposits : Tez_repr.t Signature.Public_key_hash.Map.t;
  included_endorsements : int;
  allowed_endorsements :
    (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t;
  fees : Tez_repr.t;
  rewards : Tez_repr.t;
  block_gas : Z.t;
  operation_gas : Gas_limit_repr.t;
  internal_gas : Gas_limit_repr.internal_gas;
  storage_space_to_pay : Z.t option;
  allocated_contracts : int option;
  origination_nonce : Contract_repr.origination_nonce option;
  temporary_big_map : Z.t;
  internal_nonce : int;
  internal_nonces_used : Int_set.t;
}

type context = t

type root_context = t

let current_level ctxt = ctxt.level

let predecessor_timestamp ctxt = ctxt.predecessor_timestamp

let current_timestamp ctxt = ctxt.timestamp

let current_fitness ctxt = ctxt.fitness

let first_level ctxt = ctxt.first_level

let constants ctxt = ctxt.constants

let recover ctxt = ctxt.context

let record_endorsement ctxt k =
  match Signature.Public_key_hash.Map.find_opt k ctxt.allowed_endorsements with
  | None ->
      assert false
  | Some (_, _, true) ->
      assert false (* right already used *)
  | Some (d, s, false) ->
      {
        ctxt with
        included_endorsements = ctxt.included_endorsements + List.length s;
        allowed_endorsements =
          Signature.Public_key_hash.Map.add
            k
            (d, s, true)
            ctxt.allowed_endorsements;
      }

let init_endorsements ctxt allowed_endorsements =
  if Signature.Public_key_hash.Map.is_empty allowed_endorsements then
    assert false (* can't initialize to empty *)
  else if Signature.Public_key_hash.Map.is_empty ctxt.allowed_endorsements then
    {ctxt with allowed_endorsements}
  else assert false

(* can't initialize twice *)

let allowed_endorsements ctxt = ctxt.allowed_endorsements

let included_endorsements ctxt = ctxt.included_endorsements

type error += Too_many_internal_operations (* `Permanent *)

let () =
  let open Data_encoding in
  register_error_kind
    `Permanent
    ~id:"too_many_internal_operations"
    ~title:"Too many internal operations"
    ~description:
      "A transaction exceeded the hard limit of internal operations it can emit"
    empty
    (function Too_many_internal_operations -> Some () | _ -> None)
    (fun () -> Too_many_internal_operations)

let fresh_internal_nonce ctxt =
  if Compare.Int.(ctxt.internal_nonce >= 65_535) then
    error Too_many_internal_operations
  else
    ok
      ( {ctxt with internal_nonce = ctxt.internal_nonce + 1},
        ctxt.internal_nonce )

let reset_internal_nonce ctxt =
  {ctxt with internal_nonces_used = Int_set.empty; internal_nonce = 0}

let record_internal_nonce ctxt k =
  {ctxt with internal_nonces_used = Int_set.add k ctxt.internal_nonces_used}

let internal_nonce_already_recorded ctxt k =
  Int_set.mem k ctxt.internal_nonces_used

let set_current_fitness ctxt fitness = {ctxt with fitness}

let add_fees ctxt fees =
  Lwt.return Tez_repr.(ctxt.fees +? fees)
  >>=? fun fees -> return {ctxt with fees}

let add_rewards ctxt rewards =
  Lwt.return Tez_repr.(ctxt.rewards +? rewards)
  >>=? fun rewards -> return {ctxt with rewards}

let add_deposit ctxt delegate deposit =
  let previous =
    match Signature.Public_key_hash.Map.find_opt delegate ctxt.deposits with
    | Some tz ->
        tz
    | None ->
        Tez_repr.zero
  in
  Lwt.return Tez_repr.(previous +? deposit)
  >>=? fun deposit ->
  let deposits =
    Signature.Public_key_hash.Map.add delegate deposit ctxt.deposits
  in
  return {ctxt with deposits}

let get_deposits ctxt = ctxt.deposits

let get_rewards ctxt = ctxt.rewards

let get_fees ctxt = ctxt.fees

type error += Undefined_operation_nonce (* `Permanent *)

let () =
  let open Data_encoding in
  register_error_kind
    `Permanent
    ~id:"undefined_operation_nonce"
    ~title:"Ill timed access to the origination nonce"
    ~description:
      "An origination was attemped out of the scope of a manager operation"
    empty
    (function Undefined_operation_nonce -> Some () | _ -> None)
    (fun () -> Undefined_operation_nonce)

let init_origination_nonce ctxt operation_hash =
  let origination_nonce =
    Some (Contract_repr.initial_origination_nonce operation_hash)
  in
  {ctxt with origination_nonce}

let origination_nonce ctxt =
  match ctxt.origination_nonce with
  | None ->
      error Undefined_operation_nonce
  | Some origination_nonce ->
      ok origination_nonce

let increment_origination_nonce ctxt =
  match ctxt.origination_nonce with
  | None ->
      error Undefined_operation_nonce
  | Some cur_origination_nonce ->
      let origination_nonce =
        Some (Contract_repr.incr_origination_nonce cur_origination_nonce)
      in
      ok ({ctxt with origination_nonce}, cur_origination_nonce)

let unset_origination_nonce ctxt = {ctxt with origination_nonce = None}

type error += Gas_limit_too_high (* `Permanent *)

let () =
  let open Data_encoding in
  register_error_kind
    `Permanent
    ~id:"gas_limit_too_high"
    ~title:"Gas limit out of protocol hard bounds"
    ~description:"A transaction tried to exceed the hard limit on gas"
    empty
    (function Gas_limit_too_high -> Some () | _ -> None)
    (fun () -> Gas_limit_too_high)

let check_gas_limit ctxt remaining =
  if
    Compare.Z.(remaining > ctxt.constants.hard_gas_limit_per_operation)
    || Compare.Z.(remaining < Z.zero)
  then error Gas_limit_too_high
  else ok ()

let set_gas_limit ctxt remaining =
  {
    ctxt with
    operation_gas = Limited {remaining};
    internal_gas = Gas_limit_repr.internal_gas_zero;
  }

let set_gas_unlimited ctxt = {ctxt with operation_gas = Unaccounted}

let consume_gas ctxt cost =
  Gas_limit_repr.consume
    ctxt.block_gas
    ctxt.operation_gas
    ctxt.internal_gas
    cost
  >>? fun (block_gas, operation_gas, internal_gas) ->
  ok {ctxt with block_gas; operation_gas; internal_gas}

let check_enough_gas ctxt cost =
  Gas_limit_repr.check_enough
    ctxt.block_gas
    ctxt.operation_gas
    ctxt.internal_gas
    cost

let gas_level ctxt = ctxt.operation_gas

let block_gas_level ctxt = ctxt.block_gas

let gas_consumed ~since ~until =
  match (gas_level since, gas_level until) with
  | (Limited {remaining = before}, Limited {remaining = after}) ->
      Z.sub before after
  | (_, _) ->
      Z.zero

let init_storage_space_to_pay ctxt =
  match ctxt.storage_space_to_pay with
  | Some _ ->
      assert false
  | None ->
      {
        ctxt with
        storage_space_to_pay = Some Z.zero;
        allocated_contracts = Some 0;
      }

let update_storage_space_to_pay ctxt n =
  match ctxt.storage_space_to_pay with
  | None ->
      assert false
  | Some storage_space_to_pay ->
      {ctxt with storage_space_to_pay = Some (Z.add n storage_space_to_pay)}

let update_allocated_contracts_count ctxt =
  match ctxt.allocated_contracts with
  | None ->
      assert false
  | Some allocated_contracts ->
      {ctxt with allocated_contracts = Some (succ allocated_contracts)}

let clear_storage_space_to_pay ctxt =
  match (ctxt.storage_space_to_pay, ctxt.allocated_contracts) with
  | (None, _) | (_, None) ->
      assert false
  | (Some storage_space_to_pay, Some allocated_contracts) ->
      ( {ctxt with storage_space_to_pay = None; allocated_contracts = None},
        storage_space_to_pay,
        allocated_contracts )

type storage_error =
  | Incompatible_protocol_version of string
  | Missing_key of string list * [`Get | `Set | `Del | `Copy]
  | Existing_key of string list
  | Corrupted_data of string list

let storage_error_encoding =
  let open Data_encoding in
  union
    [ case
        (Tag 0)
        ~title:"Incompatible_protocol_version"
        (obj1 (req "incompatible_protocol_version" string))
        (function Incompatible_protocol_version arg -> Some arg | _ -> None)
        (fun arg -> Incompatible_protocol_version arg);
      case
        (Tag 1)
        ~title:"Missing_key"
        (obj2
           (req "missing_key" (list string))
           (req
              "function"
              (string_enum
                 [("get", `Get); ("set", `Set); ("del", `Del); ("copy", `Copy)])))
        (function Missing_key (key, f) -> Some (key, f) | _ -> None)
        (fun (key, f) -> Missing_key (key, f));
      case
        (Tag 2)
        ~title:"Existing_key"
        (obj1 (req "existing_key" (list string)))
        (function Existing_key key -> Some key | _ -> None)
        (fun key -> Existing_key key);
      case
        (Tag 3)
        ~title:"Corrupted_data"
        (obj1 (req "corrupted_data" (list string)))
        (function Corrupted_data key -> Some key | _ -> None)
        (fun key -> Corrupted_data key) ]

let pp_storage_error ppf = function
  | Incompatible_protocol_version version ->
      Format.fprintf
        ppf
        "Found a context with an unexpected version '%s'."
        version
  | Missing_key (key, `Get) ->
      Format.fprintf ppf "Missing key '%s'." (String.concat "/" key)
  | Missing_key (key, `Set) ->
      Format.fprintf
        ppf
        "Cannot set undefined key '%s'."
        (String.concat "/" key)
  | Missing_key (key, `Del) ->
      Format.fprintf
        ppf
        "Cannot delete undefined key '%s'."
        (String.concat "/" key)
  | Missing_key (key, `Copy) ->
      Format.fprintf
        ppf
        "Cannot copy undefined key '%s'."
        (String.concat "/" key)
  | Existing_key key ->
      Format.fprintf
        ppf
        "Cannot initialize defined key '%s'."
        (String.concat "/" key)
  | Corrupted_data key ->
      Format.fprintf
        ppf
        "Failed to parse the data at '%s'."
        (String.concat "/" key)

type error += Storage_error of storage_error

let () =
  register_error_kind
    `Permanent
    ~id:"context.storage_error"
    ~title:"Storage error (fatal internal error)"
    ~description:
      "An error that should never happen unless something has been deleted or \
       corrupted in the database."
    ~pp:(fun ppf err ->
      Format.fprintf ppf "@[<v 2>Storage error:@ %a@]" pp_storage_error err)
    storage_error_encoding
    (function Storage_error err -> Some err | _ -> None)
    (fun err -> Storage_error err)

let storage_error err = fail (Storage_error err)

(* Initialization *********************************************************)

(* This key should always be populated for every version of the
   protocol.  It's absence meaning that the context is empty. *)
let version_key = ["version"]

let version_value = "alpha_current"

let version = "v1"

let first_level_key = [version; "first_level"]

let constants_key = [version; "constants"]

let protocol_param_key = ["protocol_parameters"]

let get_first_level ctxt =
  Context.get ctxt first_level_key
  >>= function
  | None ->
      storage_error (Missing_key (first_level_key, `Get))
  | Some bytes -> (
    match Data_encoding.Binary.of_bytes Raw_level_repr.encoding bytes with
    | None ->
        storage_error (Corrupted_data first_level_key)
    | Some level ->
        return level )

let set_first_level ctxt level =
  let bytes =
    Data_encoding.Binary.to_bytes_exn Raw_level_repr.encoding level
  in
  Context.set ctxt first_level_key bytes >>= fun ctxt -> return ctxt

type error += Failed_to_parse_parameter of MBytes.t

type error += Failed_to_decode_parameter of Data_encoding.json * string

let () =
  register_error_kind
    `Temporary
    ~id:"context.failed_to_parse_parameter"
    ~title:"Failed to parse parameter"
    ~description:"The protocol parameters are not valid JSON."
    ~pp:(fun ppf bytes ->
      Format.fprintf
        ppf
        "@[<v 2>Cannot parse the protocol parameter:@ %s@]"
        (MBytes.to_string bytes))
    Data_encoding.(obj1 (req "contents" bytes))
    (function Failed_to_parse_parameter data -> Some data | _ -> None)
    (fun data -> Failed_to_parse_parameter data) ;
  register_error_kind
    `Temporary
    ~id:"context.failed_to_decode_parameter"
    ~title:"Failed to decode parameter"
    ~description:"Unexpected JSON object."
    ~pp:(fun ppf (json, msg) ->
      Format.fprintf
        ppf
        "@[<v 2>Cannot decode the protocol parameter:@ %s@ %a@]"
        msg
        Data_encoding.Json.pp
        json)
    Data_encoding.(obj2 (req "contents" json) (req "error" string))
    (function
      | Failed_to_decode_parameter (json, msg) -> Some (json, msg) | _ -> None)
    (fun (json, msg) -> Failed_to_decode_parameter (json, msg))

let get_proto_param ctxt =
  Context.get ctxt protocol_param_key
  >>= function
  | None ->
      failwith "Missing protocol parameters."
  | Some bytes -> (
    match Data_encoding.Binary.of_bytes Data_encoding.json bytes with
    | None ->
        fail (Failed_to_parse_parameter bytes)
    | Some json -> (
        Context.del ctxt protocol_param_key
        >>= fun ctxt ->
        match Data_encoding.Json.destruct Parameters_repr.encoding json with
        | exception (Data_encoding.Json.Cannot_destruct _ as exn) ->
            Format.kasprintf
              failwith
              "Invalid protocol_parameters: %a %a"
              (fun ppf -> Data_encoding.Json.print_error ppf)
              exn
              Data_encoding.Json.pp
              json
        | param ->
            return (param, ctxt) ) )

let set_constants ctxt constants =
  let bytes =
    Data_encoding.Binary.to_bytes_exn
      Constants_repr.parametric_encoding
      constants
  in
  Context.set ctxt constants_key bytes

let get_constants ctxt =
  Context.get ctxt constants_key
  >>= function
  | None ->
      failwith "Internal error: cannot read constants in context."
  | Some bytes -> (
    match
      Data_encoding.Binary.of_bytes Constants_repr.parametric_encoding bytes
    with
    | None ->
        failwith "Internal error: cannot parse constants in context."
    | Some constants ->
        return constants )

let patch_constants ctxt f =
  let constants = f ctxt.constants in
  set_constants ctxt.context constants
  >>= fun context -> Lwt.return {ctxt with context; constants}

let check_inited ctxt =
  Context.get ctxt version_key
  >>= function
  | None ->
      failwith "Internal error: un-initialized context."
  | Some bytes ->
      let s = MBytes.to_string bytes in
      if Compare.String.(s = version_value) then return_unit
      else storage_error (Incompatible_protocol_version s)

let prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt =
  Lwt.return (Raw_level_repr.of_int32 level)
  >>=? fun level ->
  Lwt.return (Fitness_repr.to_int64 fitness)
  >>=? fun fitness ->
  check_inited ctxt
  >>=? fun () ->
  get_constants ctxt
  >>=? fun constants ->
  get_first_level ctxt
  >>=? fun first_level ->
  let level =
    Level_repr.from_raw
      ~first_level
      ~blocks_per_cycle:constants.Constants_repr.blocks_per_cycle
      ~blocks_per_voting_period:
        constants.Constants_repr.blocks_per_voting_period
      ~blocks_per_commitment:constants.Constants_repr.blocks_per_commitment
      level
  in
  return
    {
      context = ctxt;
      constants;
      level;
      predecessor_timestamp;
      timestamp;
      fitness;
      first_level;
      allowed_endorsements = Signature.Public_key_hash.Map.empty;
      included_endorsements = 0;
      fees = Tez_repr.zero;
      rewards = Tez_repr.zero;
      deposits = Signature.Public_key_hash.Map.empty;
      operation_gas = Unaccounted;
      internal_gas = Gas_limit_repr.internal_gas_zero;
      storage_space_to_pay = None;
      allocated_contracts = None;
      block_gas = constants.Constants_repr.hard_gas_limit_per_block;
      origination_nonce = None;
      temporary_big_map = Z.sub Z.zero Z.one;
      internal_nonce = 0;
      internal_nonces_used = Int_set.empty;
    }

type previous_protocol = Genesis of Parameters_repr.t | Alpha_previous

let check_and_update_protocol_version ctxt =
  Context.get ctxt version_key
  >>= (function
        | None ->
            failwith
              "Internal error: un-initialized context in check_first_block."
        | Some bytes ->
            let s = MBytes.to_string bytes in
            if Compare.String.(s = version_value) then
              failwith "Internal error: previously initialized context."
            else if Compare.String.(s = "genesis") then
              get_proto_param ctxt
              >>=? fun (param, ctxt) -> return (Genesis param, ctxt)
            else if Compare.String.(s = "alpha_previous") then
              return (Alpha_previous, ctxt)
            else storage_error (Incompatible_protocol_version s))
  >>=? fun (previous_proto, ctxt) ->
  Context.set ctxt version_key (MBytes.of_string version_value)
  >>= fun ctxt -> return (previous_proto, ctxt)

let prepare_first_block ~level ~timestamp ~fitness ctxt =
  check_and_update_protocol_version ctxt
  >>=? fun (previous_proto, ctxt) ->
  ( match previous_proto with
  | Genesis param ->
      Lwt.return (Raw_level_repr.of_int32 level)
      >>=? fun first_level ->
      set_first_level ctxt first_level
      >>=? fun ctxt ->
      set_constants ctxt param.constants >>= fun ctxt -> return ctxt
  | Alpha_previous ->
      return ctxt )
  >>=? fun ctxt ->
  prepare ctxt ~level ~predecessor_timestamp:timestamp ~timestamp ~fitness
  >>=? fun ctxt -> return (previous_proto, ctxt)

let activate ({context = c; _} as s) h =
  Updater.activate c h >>= fun c -> Lwt.return {s with context = c}

let fork_test_chain ({context = c; _} as s) protocol expiration =
  Updater.fork_test_chain c ~protocol ~expiration
  >>= fun c -> Lwt.return {s with context = c}

(* Generic context ********************************************************)

type key = string list

type value = MBytes.t

module type T = sig
  type t

  type context = t

  val mem : context -> key -> bool Lwt.t

  val dir_mem : context -> key -> bool Lwt.t

  val get : context -> key -> value tzresult Lwt.t

  val get_option : context -> key -> value option Lwt.t

  val init : context -> key -> value -> context tzresult Lwt.t

  val set : context -> key -> value -> context tzresult Lwt.t

  val init_set : context -> key -> value -> context Lwt.t

  val set_option : context -> key -> value option -> context Lwt.t

  val delete : context -> key -> context tzresult Lwt.t

  val remove : context -> key -> context Lwt.t

  val remove_rec : context -> key -> context Lwt.t

  val copy : context -> from:key -> to_:key -> context tzresult Lwt.t

  val fold :
    context ->
    key ->
    init:'a ->
    f:([`Key of key | `Dir of key] -> 'a -> 'a Lwt.t) ->
    'a Lwt.t

  val keys : context -> key -> key list Lwt.t

  val fold_keys :
    context -> key -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t

  val project : context -> root_context

  val absolute_key : context -> key -> key

  val consume_gas : context -> Gas_limit_repr.cost -> context tzresult

  val check_enough_gas : context -> Gas_limit_repr.cost -> unit tzresult

  val description : context Storage_description.t
end

let mem ctxt k = Context.mem ctxt.context k

let dir_mem ctxt k = Context.dir_mem ctxt.context k

let get ctxt k =
  Context.get ctxt.context k
  >>= function
  | None -> storage_error (Missing_key (k, `Get)) | Some v -> return v

let get_option ctxt k = Context.get ctxt.context k

(* Verify that the k is present before modifying *)
let set ctxt k v =
  Context.mem ctxt.context k
  >>= function
  | false ->
      storage_error (Missing_key (k, `Set))
  | true ->
      Context.set ctxt.context k v
      >>= fun context -> return {ctxt with context}

(* Verify that the k is not present before inserting *)
let init ctxt k v =
  Context.mem ctxt.context k
  >>= function
  | true ->
      storage_error (Existing_key k)
  | false ->
      Context.set ctxt.context k v
      >>= fun context -> return {ctxt with context}

(* Does not verify that the key is present or not *)
let init_set ctxt k v =
  Context.set ctxt.context k v
  >>= fun context -> Lwt.return {ctxt with context}

(* Verify that the key is present before deleting *)
let delete ctxt k =
  Context.mem ctxt.context k
  >>= function
  | false ->
      storage_error (Missing_key (k, `Del))
  | true ->
      Context.del ctxt.context k >>= fun context -> return {ctxt with context}

(* Do not verify before deleting *)
let remove ctxt k =
  Context.del ctxt.context k >>= fun context -> Lwt.return {ctxt with context}

let set_option ctxt k = function
  | None ->
      remove ctxt k
  | Some v ->
      init_set ctxt k v

let remove_rec ctxt k =
  Context.remove_rec ctxt.context k
  >>= fun context -> Lwt.return {ctxt with context}

let copy ctxt ~from ~to_ =
  Context.copy ctxt.context ~from ~to_
  >>= function
  | None ->
      storage_error (Missing_key (from, `Copy))
  | Some context ->
      return {ctxt with context}

let fold ctxt k ~init ~f = Context.fold ctxt.context k ~init ~f

let keys ctxt k = Context.keys ctxt.context k

let fold_keys ctxt k ~init ~f = Context.fold_keys ctxt.context k ~init ~f

let project x = x

let absolute_key _ k = k

let description = Storage_description.create ()

let fresh_temporary_big_map ctxt =
  ( {ctxt with temporary_big_map = Z.sub ctxt.temporary_big_map Z.one},
    ctxt.temporary_big_map )

let reset_temporary_big_map ctxt =
  {ctxt with temporary_big_map = Z.sub Z.zero Z.one}

let temporary_big_maps ctxt f acc =
  let rec iter acc id =
    if Z.equal id ctxt.temporary_big_map then Lwt.return acc
    else f acc id >>= fun acc -> iter acc (Z.sub id Z.one)
  in
  iter acc (Z.sub Z.zero Z.one)
raw_context_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* ❌ Applications of functors are not handled. *)
functor_application

Record t := {
  context : Tezos_protocol_environment_alpha__Environment.Context.t;
  constants : Tezos_raw_protocol_alpha.Constants_repr.parametric;
  first_level : Tezos_raw_protocol_alpha.Raw_level_repr.t;
  level : Tezos_raw_protocol_alpha.Level_repr.t;
  predecessor_timestamp : Tezos_protocol_environment_alpha__Environment.Time.t;
  timestamp : Tezos_protocol_environment_alpha__Environment.Time.t;
  fitness : Tezos_protocol_environment_alpha__Environment.Int64.t;
  deposits :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
      Tezos_raw_protocol_alpha.Tez_repr.t;
  included_endorsements : Z;
  allowed_endorsements :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
        list Z * bool);
  fees : Tezos_raw_protocol_alpha.Tez_repr.t;
  rewards : Tezos_raw_protocol_alpha.Tez_repr.t;
  block_gas : Tezos_protocol_environment_alpha__Environment.Z.t;
  operation_gas : Tezos_raw_protocol_alpha.Gas_limit_repr.t;
  internal_gas : Tezos_raw_protocol_alpha.Gas_limit_repr.internal_gas;
  storage_space_to_pay :
    option Tezos_protocol_environment_alpha__Environment.Z.t;
  allocated_contracts : option Z;
  origination_nonce :
    option Tezos_raw_protocol_alpha.Contract_repr.origination_nonce;
  temporary_big_map : Tezos_protocol_environment_alpha__Environment.Z.t;
  internal_nonce : Z;
  internal_nonces_used :
    Int_set.(Tezos_protocol_environment_alpha__Environment.SET.S.t) }.

Definition context := t.

Definition root_context := t.

Definition current_level (ctxt : t) : Tezos_raw_protocol_alpha.Level_repr.t :=
  level ctxt.

Definition predecessor_timestamp (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Time.t :=
  predecessor_timestamp ctxt.

Definition current_timestamp (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Time.t := timestamp ctxt.

Definition current_fitness (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Int64.t := fitness ctxt.

Definition first_level (ctxt : t) : Tezos_raw_protocol_alpha.Raw_level_repr.t :=
  first_level ctxt.

Definition constants (ctxt : t)
  : Tezos_raw_protocol_alpha.Constants_repr.parametric := constants ctxt.

Definition recover (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Context.t := context ctxt.

Definition record_endorsement
  (ctxt : t)
  (k :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.key)
  : t :=
  match Signature.Public_key_hash.Map.find_opt k (allowed_endorsements ctxt)
    with
  | None =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | Some (_, _, true) =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | Some (d, s, false) =>
    (* ❌ Record substitution not handled *)
    record_substitution
  end.

Definition init_endorsements
  (ctxt : t)
  (allowed_endorsements :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
        list Z * bool)) : t :=
  if Signature.Public_key_hash.Map.is_empty allowed_endorsements then
    (* ❌ Assert instruction is not handled. *)
    assert false
  else
    if Signature.Public_key_hash.Map.is_empty (allowed_endorsements ctxt) then
      (* ❌ Record substitution not handled *)
      record_substitution
    else
      (* ❌ Assert instruction is not handled. *)
      assert false.

Definition allowed_endorsements (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
    (Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
      list Z * bool) := allowed_endorsements ctxt.

Definition included_endorsements (ctxt : t) : Z := included_endorsements ctxt.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "too_many_internal_operations" % string
    "Too many internal operations" % string
    "A transaction exceeded the hard limit of internal operations it can emit" %
      string None empty
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Too_many_internal_operations
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Too_many_internal_operations).

Definition fresh_internal_nonce (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult (t * Z) :=
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
      (internal_nonce ctxt) 65535 then
    error
      Tezos_protocol_environment_alpha__Environment.Error_monad.Too_many_internal_operations
  else
    ok
      ((* ❌ Record substitution not handled *)
      record_substitution, (internal_nonce ctxt)).

Definition reset_internal_nonce (ctxt : t) : t :=
  (* ❌ Record substitution not handled *)
  record_substitution.

Definition record_internal_nonce
  (ctxt : t)
  (k : Int_set.(Tezos_protocol_environment_alpha__Environment.SET.S.elt)) : t :=
  (* ❌ Record substitution not handled *)
  record_substitution.

Definition internal_nonce_already_recorded
  (ctxt : t)
  (k : Int_set.(Tezos_protocol_environment_alpha__Environment.SET.S.elt))
  : bool :=
  Int_set.(Tezos_protocol_environment_alpha__Environment.SET.S.mem) k
    (internal_nonces_used ctxt).

Definition set_current_fitness
  (ctxt : t) (fitness : Tezos_protocol_environment_alpha__Environment.Int64.t)
  : t :=
  (* ❌ Record substitution not handled *)
  record_substitution.

Definition add_fees (ctxt : t) (fees : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t) :=
  op_gtgteqquestion (Lwt.__return (op_plusquestion (fees ctxt) fees))
    (fun fees =>
      __return
        (* ❌ Record substitution not handled *)
        record_substitution).

Definition add_rewards
  (ctxt : t) (rewards : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t) :=
  op_gtgteqquestion (Lwt.__return (op_plusquestion (rewards ctxt) rewards))
    (fun rewards =>
      __return
        (* ❌ Record substitution not handled *)
        record_substitution).

Definition add_deposit
  (ctxt : t)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.key)
  (deposit : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t) :=
  let previous :=
    match Signature.Public_key_hash.Map.find_opt delegate (deposits ctxt) with
    | Some tz => tz
    | None => Tez_repr.zero
    end in
  op_gtgteqquestion (Lwt.__return (op_plusquestion previous deposit))
    (fun deposit =>
      let deposits :=
        Signature.Public_key_hash.Map.add delegate deposit (deposits ctxt) in
      __return
        (* ❌ Record substitution not handled *)
        record_substitution).

Definition get_deposits (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
    Tezos_raw_protocol_alpha.Tez_repr.t := deposits ctxt.

Definition get_rewards (ctxt : t) : Tezos_raw_protocol_alpha.Tez_repr.t :=
  rewards ctxt.

Definition get_fees (ctxt : t) : Tezos_raw_protocol_alpha.Tez_repr.t :=
  fees ctxt.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "undefined_operation_nonce" % string
    "Ill timed access to the origination nonce" % string
    "An origination was attemped out of the scope of a manager operation" %
      string None empty
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Undefined_operation_nonce
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Undefined_operation_nonce).

Definition init_origination_nonce
  (ctxt : t)
  (operation_hash :
    Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  : t :=
  let origination_nonce :=
    Some (Contract_repr.initial_origination_nonce operation_hash) in
  (* ❌ Record substitution not handled *)
  record_substitution.

Definition origination_nonce (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    Tezos_raw_protocol_alpha.Contract_repr.origination_nonce :=
  match origination_nonce ctxt with
  | None =>
    error
      Tezos_protocol_environment_alpha__Environment.Error_monad.Undefined_operation_nonce
  | Some origination_nonce => ok origination_nonce
  end.

Definition increment_origination_nonce (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (t * Tezos_raw_protocol_alpha.Contract_repr.origination_nonce) :=
  match origination_nonce ctxt with
  | None =>
    error
      Tezos_protocol_environment_alpha__Environment.Error_monad.Undefined_operation_nonce
  | Some cur_origination_nonce =>
    let origination_nonce :=
      Some (Contract_repr.incr_origination_nonce cur_origination_nonce) in
    ok
      ((* ❌ Record substitution not handled *)
      record_substitution, cur_origination_nonce)
  end.

Definition unset_origination_nonce (ctxt : t) : t :=
  (* ❌ Record substitution not handled *)
  record_substitution.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "gas_limit_too_high" % string
    "Gas limit out of protocol hard bounds" % string
    "A transaction tried to exceed the hard limit on gas" % string None empty
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_limit_too_high
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_limit_too_high).

Definition check_gas_limit
  (ctxt : t)
  (remaining :
    Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
  if
    op_pipepipe
      (Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
        remaining (hard_gas_limit_per_operation (constants ctxt)))
      (Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
        remaining Z.zero) then
    error
      Tezos_protocol_environment_alpha__Environment.Error_monad.Gas_limit_too_high
  else
    ok tt.

Definition set_gas_limit
  (ctxt : t) (remaining : Tezos_protocol_environment_alpha__Environment.Z.t)
  : t :=
  (* ❌ Record substitution not handled *)
  record_substitution.

Definition set_gas_unlimited (ctxt : t) : t :=
  (* ❌ Record substitution not handled *)
  record_substitution.

Definition consume_gas
  (ctxt : t) (cost : Tezos_raw_protocol_alpha.Gas_limit_repr.cost)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t :=
  op_gtgtquestion
    (Gas_limit_repr.consume (block_gas ctxt) (operation_gas ctxt)
      (internal_gas ctxt) cost)
    (fun function_parameter =>
      let '(block_gas, operation_gas, internal_gas) := function_parameter in
      ok
        (* ❌ Record substitution not handled *)
        record_substitution).

Definition check_enough_gas
  (ctxt : t) (cost : Tezos_raw_protocol_alpha.Gas_limit_repr.cost)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
  Gas_limit_repr.check_enough (block_gas ctxt) (operation_gas ctxt)
    (internal_gas ctxt) cost.

Definition gas_level (ctxt : t) : Tezos_raw_protocol_alpha.Gas_limit_repr.t :=
  operation_gas ctxt.

Definition block_gas_level (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Z.t := block_gas ctxt.

Definition gas_consumed (since : t) (until : t)
  : Tezos_protocol_environment_alpha__Environment.Z.t :=
  match ((gas_level since), (gas_level until)) with
  |
    (Tezos_raw_protocol_alpha.Gas_limit_repr.Limited {| remaining := before |},
      Tezos_raw_protocol_alpha.Gas_limit_repr.Limited {| remaining := after |})
    => Z.sub before after
  | (_, _) => Z.zero
  end.

Definition init_storage_space_to_pay (ctxt : t) : t :=
  match storage_space_to_pay ctxt with
  | Some _ =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | None =>
    (* ❌ Record substitution not handled *)
    record_substitution
  end.

Definition update_storage_space_to_pay
  (ctxt : t) (n : Tezos_protocol_environment_alpha__Environment.Z.t) : t :=
  match storage_space_to_pay ctxt with
  | None =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | Some storage_space_to_pay =>
    (* ❌ Record substitution not handled *)
    record_substitution
  end.

Definition update_allocated_contracts_count (ctxt : t) : t :=
  match allocated_contracts ctxt with
  | None =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | Some allocated_contracts =>
    (* ❌ Record substitution not handled *)
    record_substitution
  end.

Definition clear_storage_space_to_pay (ctxt : t)
  : t * Tezos_protocol_environment_alpha__Environment.Z.t * Z :=
  match ((storage_space_to_pay ctxt), (allocated_contracts ctxt)) with
  | (None, _) | (_, None) =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | (Some storage_space_to_pay, Some allocated_contracts) =>
    ((* ❌ Record substitution not handled *)
    record_substitution, storage_space_to_pay, allocated_contracts)
  end.

Inductive storage_error : Type :=
| Incompatible_protocol_version : string -> storage_error
| Missing_key : forall {variant : Type}, list string -> variant -> storage_error
| Existing_key : list string -> storage_error
| Corrupted_data : list string -> storage_error.

Definition storage_error_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    storage_error :=
  union None
    (cons
      (case "Incompatible_protocol_version" % string None
        (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
        (obj1 (req None None "incompatible_protocol_version" % string string))
        (fun function_parameter =>
          match function_parameter with
          | Incompatible_protocol_version arg => Some arg
          | _ => None
          end) (fun arg => Incompatible_protocol_version arg))
      (cons
        (case "Missing_key" % string None
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
          (obj2 (req None None "missing_key" % string (list None string))
            (req None None "function" % string
              (string_enum
                (cons
                  ("get" % string,
                    (* ❌ Variants not supported *)
                    variant)
                  (cons
                    ("set" % string,
                      (* ❌ Variants not supported *)
                      variant)
                    (cons
                      ("del" % string,
                        (* ❌ Variants not supported *)
                        variant)
                      (cons
                        ("copy" % string,
                          (* ❌ Variants not supported *)
                          variant) [])))))))
          (fun function_parameter =>
            match function_parameter with
            | Missing_key key f => Some (key, f)
            | _ => None
            end)
          (fun function_parameter =>
            let '(key, f) := function_parameter in
            Missing_key key f))
        (cons
          (case "Existing_key" % string None
            (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 2)
            (obj1 (req None None "existing_key" % string (list None string)))
            (fun function_parameter =>
              match function_parameter with
              | Existing_key key => Some key
              | _ => None
              end) (fun key => Existing_key key))
          (cons
            (case "Corrupted_data" % string None
              (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 3)
              (obj1 (req None None "corrupted_data" % string (list None string)))
              (fun function_parameter =>
                match function_parameter with
                | Corrupted_data key => Some key
                | _ => None
                end) (fun key => Corrupted_data key)) [])))).

Definition pp_storage_error
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (function_parameter : storage_error) : unit :=
  match function_parameter with
  | Incompatible_protocol_version version =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
          "Found a context with an unexpected version '" % string
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
              "'." % string
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
        "Found a context with an unexpected version '%s'." % string) version
  | Missing_key key Get =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
          "Missing key '" % string
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
              "'." % string
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
        "Missing key '%s'." % string) (String.concat "/" % string key)
  | Missing_key key Set =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
          "Cannot set undefined key '" % string
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
              "'." % string
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
        "Cannot set undefined key '%s'." % string)
      (String.concat "/" % string key)
  | Missing_key key Del =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
          "Cannot delete undefined key '" % string
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
              "'." % string
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
        "Cannot delete undefined key '%s'." % string)
      (String.concat "/" % string key)
  | Missing_key key Copy =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
          "Cannot copy undefined key '" % string
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
              "'." % string
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
        "Cannot copy undefined key '%s'." % string)
      (String.concat "/" % string key)
  | Existing_key key =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
          "Cannot initialize defined key '" % string
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
              "'." % string
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
        "Cannot initialize defined key '%s'." % string)
      (String.concat "/" % string key)
  | Corrupted_data key =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
          "Failed to parse the data at '" % string
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
              "'." % string
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
        "Failed to parse the data at '%s'." % string)
      (String.concat "/" % string key)
  end.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "context.storage_error" % string
    "Storage error (fatal internal error)" % string
    "An error that should never happen unless something has been deleted or corrupted in the database."
      % string
    (Some
      (fun ppf =>
        fun err =>
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_gen
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Open_box
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      "<v 2>" % string
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                    "<v 2>" % string))
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Storage error:" % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Break
                      "@ " % string 1 0)
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Close_box
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
              "@[<v 2>Storage error:@ %a@]" % string) pp_storage_error err))
    storage_error_encoding
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Storage_error
          err => Some err
      | _ => None
      end)
    (fun err =>
      Tezos_protocol_environment_alpha__Environment.Error_monad.Storage_error
        err).

Definition storage_error {A : Type} (err : storage_error)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  fail
    (Tezos_protocol_environment_alpha__Environment.Error_monad.Storage_error err).

Definition version_key : list string := cons "version" % string [].

Definition version_value : string := "alpha_current" % string.

Definition version : string := "v1" % string.

Definition first_level_key : list string :=
  cons version (cons "first_level" % string []).

Definition constants_key : list string :=
  cons version (cons "constants" % string []).

Definition protocol_param_key : list string :=
  cons "protocol_parameters" % string [].

Definition get_first_level
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_level_repr.raw_level) :=
  op_gtgteq (Context.get ctxt first_level_key)
    (fun function_parameter =>
      match function_parameter with
      | None =>
        storage_error
          (Missing_key first_level_key
            (* ❌ Variants not supported *)
            variant)
      | Some bytes =>
        match Data_encoding.Binary.of_bytes Raw_level_repr.encoding string with
        | None => storage_error (Corrupted_data first_level_key)
        | Some level => __return level
        end
      end).

Definition set_first_level
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  (level : Tezos_raw_protocol_alpha.Raw_level_repr.raw_level)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Context.t) :=
  let bytes := Data_encoding.Binary.to_bytes_exn Raw_level_repr.encoding level
    in
  op_gtgteq (Context.set ctxt first_level_key string)
    (fun ctxt => __return ctxt).

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "context.failed_to_parse_parameter" % string
      "Failed to parse parameter" % string
      "The protocol parameters are not valid JSON." % string
      (Some
        (fun ppf =>
          fun bytes =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_gen
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Open_box
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                        "<v 2>" % string
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                      "<v 2>" % string))
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    "Cannot parse the protocol parameter:" % string
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Break
                        "@ " % string 1 0)
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Close_box
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "@[<v 2>Cannot parse the protocol parameter:@ %s@]" % string)
              (MBytes.to_string string)))
      (obj1 (req None None "contents" % string bytes))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Failed_to_parse_parameter
            data => Some data
        | _ => None
        end)
      (fun data =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Failed_to_parse_parameter
          data) in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "context.failed_to_decode_parameter" % string
    "Failed to decode parameter" % string "Unexpected JSON object." % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let '(json, msg) := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_gen
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Open_box
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      "<v 2>" % string
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                    "<v 2>" % string))
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Cannot decode the protocol parameter:" % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Break
                      "@ " % string 1 0)
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Break
                          "@ " % string 1 0)
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Close_box
                            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))))
              "@[<v 2>Cannot decode the protocol parameter:@ %s@ %a@]" % string)
            msg Data_encoding.Json.pp json))
    (obj2 (req None None "contents" % string json)
      (req None None "error" % string string))
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Failed_to_decode_parameter
          json msg => Some (json, msg)
      | _ => None
      end)
    (fun function_parameter =>
      let '(json, msg) := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Failed_to_decode_parameter
        json msg).

Definition get_proto_param
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Parameters_repr.t *
        Tezos_protocol_environment_alpha__Environment.Context.t)) :=
  op_gtgteq (Context.get ctxt protocol_param_key)
    (fun function_parameter =>
      match function_parameter with
      | None => failwith "Missing protocol parameters." % string
      | Some bytes =>
        match Data_encoding.Binary.of_bytes Data_encoding.json string with
        | None =>
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Failed_to_parse_parameter
              string)
        | Some json =>
          op_gtgteq (Context.del ctxt protocol_param_key)
            (fun ctxt =>
              let 'param :=
                Data_encoding.Json.destruct Parameters_repr.encoding json in
              __return (param, ctxt))
        end
      end).

Definition set_constants
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  (constants : Tezos_raw_protocol_alpha.Constants_repr.parametric)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    Tezos_protocol_environment_alpha__Environment.Context.t :=
  let bytes :=
    Data_encoding.Binary.to_bytes_exn Constants_repr.parametric_encoding
      constants in
  Context.set ctxt constants_key string.

Definition get_constants
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Constants_repr.parametric) :=
  op_gtgteq (Context.get ctxt constants_key)
    (fun function_parameter =>
      match function_parameter with
      | None =>
        failwith "Internal error: cannot read constants in context." % string
      | Some bytes =>
        match
          Data_encoding.Binary.of_bytes Constants_repr.parametric_encoding
            string with
        | None =>
          failwith "Internal error: cannot parse constants in context." % string
        | Some constants => __return constants
        end
      end).

Definition patch_constants
  (ctxt : t)
  (f :
    Tezos_raw_protocol_alpha.Constants_repr.parametric ->
      Tezos_raw_protocol_alpha.Constants_repr.parametric)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t t :=
  let constants := f (constants ctxt) in
  op_gtgteq (set_constants (context ctxt) constants)
    (fun context =>
      Lwt.__return
        (* ❌ Record substitution not handled *)
        record_substitution).

Definition check_inited
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  op_gtgteq (Context.get ctxt version_key)
    (fun function_parameter =>
      match function_parameter with
      | None => failwith "Internal error: un-initialized context." % string
      | Some bytes =>
        let s := MBytes.to_string string in
        if
          Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
            s version_value then
          return_unit
        else
          storage_error (Incompatible_protocol_version s)
      end).

Definition prepare
  (level : int32)
  (predecessor_timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (fitness : list Tezos_protocol_environment_alpha__Environment.MBytes.t)
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t) :=
  op_gtgteqquestion (Lwt.__return (Raw_level_repr.of_int32 level))
    (fun level =>
      op_gtgteqquestion (Lwt.__return (Fitness_repr.to_int64 fitness))
        (fun fitness =>
          op_gtgteqquestion (check_inited ctxt)
            (fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteqquestion (get_constants ctxt)
                (fun constants =>
                  op_gtgteqquestion (get_first_level ctxt)
                    (fun first_level =>
                      let level :=
                        Level_repr.from_raw first_level
                          (Constants_repr.blocks_per_cycle constants)
                          (Constants_repr.blocks_per_voting_period constants)
                          (Constants_repr.blocks_per_commitment constants) level
                        in
                      __return
                        {| context := ctxt; constants := constants;
                          first_level := first_level; level := level;
                          predecessor_timestamp := predecessor_timestamp;
                          timestamp := timestamp; fitness := fitness;
                          deposits := Signature.Public_key_hash.Map.empty;
                          included_endorsements := 0;
                          allowed_endorsements :=
                            Signature.Public_key_hash.Map.empty;
                          fees := Tez_repr.zero; rewards := Tez_repr.zero;
                          block_gas :=
                            Constants_repr.hard_gas_limit_per_block constants;
                          operation_gas :=
                            Tezos_raw_protocol_alpha.Gas_limit_repr.Unaccounted;
                          internal_gas := Gas_limit_repr.internal_gas_zero;
                          storage_space_to_pay := None;
                          allocated_contracts := None;
                          origination_nonce := None;
                          temporary_big_map := Z.sub Z.zero Z.one;
                          internal_nonce := 0;
                          internal_nonces_used :=
                            Int_set.(Tezos_protocol_environment_alpha__Environment.SET.S.empty)
                          |}))))).

Inductive previous_protocol : Type :=
| Genesis : Tezos_raw_protocol_alpha.Parameters_repr.t -> previous_protocol
| Alpha_previous : previous_protocol.

Definition check_and_update_protocol_version
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (previous_protocol *
        Tezos_protocol_environment_alpha__Environment.Context.t)) :=
  op_gtgteqquestion
    (op_gtgteq (Context.get ctxt version_key)
      (fun function_parameter =>
        match function_parameter with
        | None =>
          failwith
            "Internal error: un-initialized context in check_first_block." %
              string
        | Some bytes =>
          let s := MBytes.to_string string in
          if
            Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
              s version_value then
            failwith "Internal error: previously initialized context." % string
          else
            if
              Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
                s "genesis" % string then
              op_gtgteqquestion (get_proto_param ctxt)
                (fun function_parameter =>
                  let '(param, ctxt) := function_parameter in
                  __return ((Genesis param), ctxt))
            else
              if
                Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
                  s "alpha_previous" % string then
                __return (Alpha_previous, ctxt)
              else
                storage_error (Incompatible_protocol_version s)
        end))
    (fun function_parameter =>
      let '(previous_proto, ctxt) := function_parameter in
      op_gtgteq (Context.set ctxt version_key (MBytes.of_string version_value))
        (fun ctxt => __return (previous_proto, ctxt))).

Definition prepare_first_block
  (level : int32)
  (timestamp : Tezos_protocol_environment_alpha__Environment.Time.t)
  (fitness : list Tezos_protocol_environment_alpha__Environment.MBytes.t)
  (ctxt : Tezos_protocol_environment_alpha__Environment.Context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (previous_protocol * t)) :=
  op_gtgteqquestion (check_and_update_protocol_version ctxt)
    (fun function_parameter =>
      let '(previous_proto, ctxt) := function_parameter in
      op_gtgteqquestion
        match previous_proto with
        | Genesis param =>
          op_gtgteqquestion (Lwt.__return (Raw_level_repr.of_int32 level))
            (fun first_level =>
              op_gtgteqquestion (set_first_level ctxt first_level)
                (fun ctxt =>
                  op_gtgteq (set_constants ctxt (constants param))
                    (fun ctxt => __return ctxt)))
        | Alpha_previous => __return ctxt
        end
        (fun ctxt =>
          op_gtgteqquestion (prepare level timestamp timestamp fitness ctxt)
            (fun ctxt => __return (previous_proto, ctxt)))).

Definition activate (function_parameter : t)
  : Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
    -> Tezos_protocol_environment_alpha__Environment.Lwt.t t :=
  let '{| context := c |} as s := function_parameter in
  fun h =>
    op_gtgteq (Updater.activate c h)
      (fun c =>
        Lwt.__return
          (* ❌ Record substitution not handled *)
          record_substitution).

Definition fork_test_chain (function_parameter : t)
  : Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
    ->
    Tezos_protocol_environment_alpha__Environment.Time.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t t :=
  let '{| context := c |} as s := function_parameter in
  fun protocol =>
    fun expiration =>
      op_gtgteq (Updater.fork_test_chain c protocol expiration)
        (fun c =>
          Lwt.__return
            (* ❌ Record substitution not handled *)
            record_substitution).

Definition key := list string.

Definition value := Tezos_protocol_environment_alpha__Environment.MBytes.t.

Module T.
  Record signature {t : Type} := {
    t := t;
    context := t;
    mem : context ->
      key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool;
    dir_mem : context ->
      key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool;
    get : context ->
      key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            value);
    get_option : context ->
      key -> Tezos_protocol_environment_alpha__Environment.Lwt.t (option value);
    init : context ->
      key ->
        value ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              context);
    set : context ->
      key ->
        value ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              context);
    init_set : context ->
      key ->
        value -> Tezos_protocol_environment_alpha__Environment.Lwt.t context;
    set_option : context ->
      key ->
        option value ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t context;
    delete : context ->
      key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            context);
    remove : context ->
      key -> Tezos_protocol_environment_alpha__Environment.Lwt.t context;
    remove_rec : context ->
      key -> Tezos_protocol_environment_alpha__Environment.Lwt.t context;
    copy : context ->
      key ->
        key ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              context);
    fold : forall {a variant : Type}, context ->
      key ->
        a ->
          (variant -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a)
            -> Tezos_protocol_environment_alpha__Environment.Lwt.t a;
    keys : context ->
      key -> Tezos_protocol_environment_alpha__Environment.Lwt.t (list key);
    fold_keys : forall {a : Type}, context ->
      key ->
        a ->
          (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t a;
    project : context -> root_context;
    absolute_key : context -> key -> key;
    consume_gas : context ->
      Tezos_raw_protocol_alpha.Gas_limit_repr.cost ->
        Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          context;
    check_enough_gas : context ->
      Tezos_raw_protocol_alpha.Gas_limit_repr.cost ->
        Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit;
    description : Tezos_raw_protocol_alpha.Storage_description.t context;
  }.
  Arguments signature : clear implicits.
End T.

Definition mem
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t bool :=
  Context.mem (context ctxt) k.

Definition dir_mem
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t bool :=
  Context.dir_mem (context ctxt) k.

Definition get
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Context.value) :=
  op_gtgteq (Context.get (context ctxt) k)
    (fun function_parameter =>
      match function_parameter with
      | None =>
        storage_error
          (Missing_key k
            (* ❌ Variants not supported *)
            variant)
      | Some v => __return v
      end).

Definition get_option
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (option Tezos_protocol_environment_alpha__Environment.Context.value) :=
  Context.get (context ctxt) k.

Definition set
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  (v : Tezos_protocol_environment_alpha__Environment.Context.value)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t) :=
  op_gtgteq (Context.mem (context ctxt) k)
    (fun function_parameter =>
      match function_parameter with
      | false =>
        storage_error
          (Missing_key k
            (* ❌ Variants not supported *)
            variant)
      | true =>
        op_gtgteq (Context.set (context ctxt) k v)
          (fun context =>
            __return
              (* ❌ Record substitution not handled *)
              record_substitution)
      end).

Definition init
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  (v : Tezos_protocol_environment_alpha__Environment.Context.value)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t) :=
  op_gtgteq (Context.mem (context ctxt) k)
    (fun function_parameter =>
      match function_parameter with
      | true => storage_error (Existing_key k)
      | false =>
        op_gtgteq (Context.set (context ctxt) k v)
          (fun context =>
            __return
              (* ❌ Record substitution not handled *)
              record_substitution)
      end).

Definition init_set
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  (v : Tezos_protocol_environment_alpha__Environment.Context.value)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t t :=
  op_gtgteq (Context.set (context ctxt) k v)
    (fun context =>
      Lwt.__return
        (* ❌ Record substitution not handled *)
        record_substitution).

Definition delete
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t) :=
  op_gtgteq (Context.mem (context ctxt) k)
    (fun function_parameter =>
      match function_parameter with
      | false =>
        storage_error
          (Missing_key k
            (* ❌ Variants not supported *)
            variant)
      | true =>
        op_gtgteq (Context.del (context ctxt) k)
          (fun context =>
            __return
              (* ❌ Record substitution not handled *)
              record_substitution)
      end).

Definition remove
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t t :=
  op_gtgteq (Context.del (context ctxt) k)
    (fun context =>
      Lwt.__return
        (* ❌ Record substitution not handled *)
        record_substitution).

Definition set_option
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  (function_parameter :
    option Tezos_protocol_environment_alpha__Environment.Context.value)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t t :=
  match function_parameter with
  | None => remove ctxt k
  | Some v => init_set ctxt k v
  end.

Definition remove_rec
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t t :=
  op_gtgteq (Context.remove_rec (context ctxt) k)
    (fun context =>
      Lwt.__return
        (* ❌ Record substitution not handled *)
        record_substitution).

Definition copy
  (ctxt : t) (from : Tezos_protocol_environment_alpha__Environment.Context.key)
  (to_ : Tezos_protocol_environment_alpha__Environment.Context.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t) :=
  op_gtgteq (Context.copy (context ctxt) from to_)
    (fun function_parameter =>
      match function_parameter with
      | None =>
        storage_error
          (Missing_key from
            (* ❌ Variants not supported *)
            variant)
      | Some context =>
        __return
          (* ❌ Record substitution not handled *)
          record_substitution
      end).

Definition fold {A : Type}
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  (init : A)
  (f : variant -> A -> Tezos_protocol_environment_alpha__Environment.Lwt.t A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t A :=
  Context.fold (context ctxt) k init f.

Definition keys
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (list Tezos_protocol_environment_alpha__Environment.Context.key) :=
  Context.keys (context ctxt) k.

Definition fold_keys {A : Type}
  (ctxt : t) (k : Tezos_protocol_environment_alpha__Environment.Context.key)
  (init : A)
  (f :
    Tezos_protocol_environment_alpha__Environment.Context.key ->
      A -> Tezos_protocol_environment_alpha__Environment.Lwt.t A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t A :=
  Context.fold_keys (context ctxt) k init f.

Definition project {A : Type} (x : A) : A := x.

Definition absolute_key {A B : Type} (function_parameter : A) : B -> B :=
  let '_ := function_parameter in
  fun k => k.

Definition description {A : Type}
  : Tezos_raw_protocol_alpha.Storage_description.t A :=
  Storage_description.create tt.

Definition fresh_temporary_big_map (ctxt : t)
  : t * Tezos_protocol_environment_alpha__Environment.Z.t :=
  ((* ❌ Record substitution not handled *)
  record_substitution, (temporary_big_map ctxt)).

Definition reset_temporary_big_map (ctxt : t) : t :=
  (* ❌ Record substitution not handled *)
  record_substitution.

Definition temporary_big_maps {A : Type}
  (ctxt : t)
  (f :
    A ->
      Tezos_protocol_environment_alpha__Environment.Z.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t A) (acc : A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t A :=
  let fix iter
    (acc : A) (id : Tezos_protocol_environment_alpha__Environment.Z.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t A :=
    if Z.equal id (temporary_big_map ctxt) then
      Lwt.__return acc
    else
      op_gtgteq (f acc id) (fun acc => iter acc (Z.sub id Z.one)) in
  iter acc (Z.sub Z.zero Z.one).
raw_context.mli 15 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** {1 Errors} *)

type error += Too_many_internal_operations (* `Permanent *)

(** An internal storage error that should not happen *)
type storage_error =
  | Incompatible_protocol_version of string
  | Missing_key of string list * [`Get | `Set | `Del | `Copy]
  | Existing_key of string list
  | Corrupted_data of string list

type error += Storage_error of storage_error

type error += Failed_to_parse_parameter of MBytes.t

type error += Failed_to_decode_parameter of Data_encoding.json * string

val storage_error : storage_error -> 'a tzresult Lwt.t

(** {1 Abstract Context} *)

(** Abstract view of the context.
    Includes a handle to the functional key-value database
    ({!Context.t}) along with some in-memory values (gas, etc.). *)
type t

type context = t

type root_context = t

(** Retrieves the state of the database and gives its abstract view.
    It also returns wether this is the first block validated
    with this version of the protocol. *)
val prepare :
  level:Int32.t ->
  predecessor_timestamp:Time.t ->
  timestamp:Time.t ->
  fitness:Fitness.t ->
  Context.t ->
  context tzresult Lwt.t

type previous_protocol = Genesis of Parameters_repr.t | Alpha_previous

val prepare_first_block :
  level:int32 ->
  timestamp:Time.t ->
  fitness:Fitness.t ->
  Context.t ->
  (previous_protocol * context) tzresult Lwt.t

val activate : context -> Protocol_hash.t -> t Lwt.t

val fork_test_chain : context -> Protocol_hash.t -> Time.t -> t Lwt.t

(** Returns the state of the database resulting of operations on its
    abstract view *)
val recover : context -> Context.t

val current_level : context -> Level_repr.t

val predecessor_timestamp : context -> Time.t

val current_timestamp : context -> Time.t

val current_fitness : context -> Int64.t

val set_current_fitness : context -> Int64.t -> t

val constants : context -> Constants_repr.parametric

val patch_constants :
  context ->
  (Constants_repr.parametric -> Constants_repr.parametric) ->
  context Lwt.t

val first_level : context -> Raw_level_repr.t

(** Increment the current block fee stash that will be credited to baker's
    frozen_fees account at finalize_application *)
val add_fees : context -> Tez_repr.t -> context tzresult Lwt.t

(** Increment the current block reward stash that will be credited to baker's
    frozen_fees account at finalize_application *)
val add_rewards : context -> Tez_repr.t -> context tzresult Lwt.t

(** Increment the current block deposit stash for a specific delegate. All the
    delegates' frozen_deposit accounts are credited at finalize_application *)
val add_deposit :
  context ->
  Signature.Public_key_hash.t ->
  Tez_repr.t ->
  context tzresult Lwt.t

val get_fees : context -> Tez_repr.t

val get_rewards : context -> Tez_repr.t

val get_deposits : context -> Tez_repr.t Signature.Public_key_hash.Map.t

type error += Gas_limit_too_high (* `Permanent *)

val check_gas_limit : t -> Z.t -> unit tzresult

val set_gas_limit : t -> Z.t -> t

val set_gas_unlimited : t -> t

val gas_level : t -> Gas_limit_repr.t

val gas_consumed : since:t -> until:t -> Z.t

val block_gas_level : t -> Z.t

val init_storage_space_to_pay : t -> t

val update_storage_space_to_pay : t -> Z.t -> t

val update_allocated_contracts_count : t -> t

val clear_storage_space_to_pay : t -> t * Z.t * int

type error += Undefined_operation_nonce (* `Permanent *)

val init_origination_nonce : t -> Operation_hash.t -> t

val origination_nonce : t -> Contract_repr.origination_nonce tzresult

val increment_origination_nonce :
  t -> (t * Contract_repr.origination_nonce) tzresult

val unset_origination_nonce : t -> t

(** {1 Generic accessors} *)

type key = string list

type value = MBytes.t

(** All context manipulation functions. This signature is included
    as-is for direct context accesses, and used in {!Storage_functors}
    to provide restricted views to the context. *)
module type T = sig
  type t

  type context = t

  (** Tells if the key is already defined as a value. *)
  val mem : context -> key -> bool Lwt.t

  (** Tells if the key is already defined as a directory. *)
  val dir_mem : context -> key -> bool Lwt.t

  (** Retrieve the value from the storage bucket ; returns a
      {!Storage_error Missing_key} if the key is not set. *)
  val get : context -> key -> value tzresult Lwt.t

  (** Retrieves the value from the storage bucket ; returns [None] if
      the data is not initialized. *)
  val get_option : context -> key -> value option Lwt.t

  (** Allocates the storage bucket and initializes it ; returns a
      {!Storage_error Existing_key} if the bucket exists. *)
  val init : context -> key -> value -> context tzresult Lwt.t

  (** Updates the content of the bucket ; returns a {!Storage_error
      Missing_key} if the value does not exists. *)
  val set : context -> key -> value -> context tzresult Lwt.t

  (** Allocates the data and initializes it with a value ; just
      updates it if the bucket exists. *)
  val init_set : context -> key -> value -> context Lwt.t

  (** When the value is [Some v], allocates the data and initializes
      it with [v] ; just updates it if the bucket exists. When the
      valus is [None], delete the storage bucket when the value ; does
      nothing if the bucket does not exists. *)
  val set_option : context -> key -> value option -> context Lwt.t

  (** Delete the storage bucket ; returns a {!Storage_error
      Missing_key} if the bucket does not exists. *)
  val delete : context -> key -> context tzresult Lwt.t

  (** Removes the storage bucket and its contents ; does nothing if the
      bucket does not exists. *)
  val remove : context -> key -> context Lwt.t

  (** Recursively removes all the storage buckets and contents ; does
      nothing if no bucket exists. *)
  val remove_rec : context -> key -> context Lwt.t

  val copy : context -> from:key -> to_:key -> context tzresult Lwt.t

  (** Iterator on all the items of a given directory. *)
  val fold :
    context ->
    key ->
    init:'a ->
    f:([`Key of key | `Dir of key] -> 'a -> 'a Lwt.t) ->
    'a Lwt.t

  (** Recursively list all subkeys of a given key. *)
  val keys : context -> key -> key list Lwt.t

  (** Recursive iterator on all the subkeys of a given key. *)
  val fold_keys :
    context -> key -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t

  (** Internally used in {!Storage_functors} to escape from a view. *)
  val project : context -> root_context

  (** Internally used in {!Storage_functors} to retrieve a full key
      from partial key relative a view. *)
  val absolute_key : context -> key -> key

  (** Internally used in {!Storage_functors} to consume gas from
      within a view. *)
  val consume_gas : context -> Gas_limit_repr.cost -> context tzresult

  (** Check if consume_gas will fail *)
  val check_enough_gas : context -> Gas_limit_repr.cost -> unit tzresult

  val description : context Storage_description.t
end

include T with type t := t and type context := context

(** Initialize the local nonce used for preventing a script to
    duplicate an internal operation to replay it. *)
val reset_internal_nonce : context -> context

(** Increments the internal operation nonce. *)
val fresh_internal_nonce : context -> (context * int) tzresult

(** Mark an internal operation nonce as taken. *)
val record_internal_nonce : context -> int -> context

(** Check is the internal operation nonce has been taken. *)
val internal_nonce_already_recorded : context -> int -> bool

(** Returns a map where to each endorser's pkh is associated the list of its
    endorsing slots (in decreasing order) for a given level. *)
val allowed_endorsements :
  context ->
  (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t

(** Keep track of the number of endorsements that are included in a block *)
val included_endorsements : context -> int

(** Initializes the map of allowed endorsements, this function must only be
    called once. *)
val init_endorsements :
  context ->
  (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t ->
  context

(** Marks an endorsment in the map as used. *)
val record_endorsement : context -> Signature.Public_key_hash.t -> context

(** Provide a fresh identifier for a temporary big map (negative index). *)
val fresh_temporary_big_map : context -> context * Z.t

(** Reset the temporary big_map identifier generator to [-1]. *)
val reset_temporary_big_map : context -> context

(** Iterate over all created temporary big maps since the last {!reset_temporary_big_map}. *)
val temporary_big_maps : context -> ('a -> Z.t -> 'a Lwt.t) -> 'a -> 'a Lwt.t
raw_context_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

extensible_type

Inductive storage_error : Type :=
| Incompatible_protocol_version : string -> storage_error
| Missing_key : forall {variant : Type}, list string -> variant -> storage_error
| Existing_key : list string -> storage_error
| Corrupted_data : list string -> storage_error.

extensible_type

extensible_type

extensible_type

Parameter storage_error : forall {a : Type},
storage_error ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult a).

Parameter t : Type.

Definition context := t.

Definition root_context := t.

Parameter prepare :
Tezos_protocol_environment_alpha__Environment.Int32.t ->
  Tezos_protocol_environment_alpha__Environment.Time.t ->
    Tezos_protocol_environment_alpha__Environment.Time.t ->
      Tezos_protocol_environment_alpha__Environment.Fitness.(Tezos_protocol_environment_alpha__Environment.T.S.t)
        ->
        Tezos_protocol_environment_alpha__Environment.Context.t ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              context).

Inductive previous_protocol : Type :=
| Genesis : Tezos_raw_protocol_alpha.Parameters_repr.t -> previous_protocol
| Alpha_previous : previous_protocol.

Parameter prepare_first_block :
int32 ->
  Tezos_protocol_environment_alpha__Environment.Time.t ->
    Tezos_protocol_environment_alpha__Environment.Fitness.(Tezos_protocol_environment_alpha__Environment.T.S.t)
      ->
      Tezos_protocol_environment_alpha__Environment.Context.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (previous_protocol * context)).

Parameter activate :
context ->
  Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
    -> Tezos_protocol_environment_alpha__Environment.Lwt.t t.

Parameter fork_test_chain :
context ->
  Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
    ->
    Tezos_protocol_environment_alpha__Environment.Time.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t t.

Parameter recover :
context -> Tezos_protocol_environment_alpha__Environment.Context.t.

Parameter current_level : context -> Tezos_raw_protocol_alpha.Level_repr.t.

Parameter predecessor_timestamp :
context -> Tezos_protocol_environment_alpha__Environment.Time.t.

Parameter current_timestamp :
context -> Tezos_protocol_environment_alpha__Environment.Time.t.

Parameter current_fitness :
context -> Tezos_protocol_environment_alpha__Environment.Int64.t.

Parameter set_current_fitness :
context -> Tezos_protocol_environment_alpha__Environment.Int64.t -> t.

Parameter constants :
context -> Tezos_raw_protocol_alpha.Constants_repr.parametric.

Parameter patch_constants :
context ->
  (Tezos_raw_protocol_alpha.Constants_repr.parametric ->
    Tezos_raw_protocol_alpha.Constants_repr.parametric) ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t context.

Parameter first_level : context -> Tezos_raw_protocol_alpha.Raw_level_repr.t.

Parameter add_fees :
context ->
  Tezos_raw_protocol_alpha.Tez_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).

Parameter add_rewards :
context ->
  Tezos_raw_protocol_alpha.Tez_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        context).

Parameter add_deposit :
context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_raw_protocol_alpha.Tez_repr.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          context).

Parameter get_fees : context -> Tezos_raw_protocol_alpha.Tez_repr.t.

Parameter get_rewards : context -> Tezos_raw_protocol_alpha.Tez_repr.t.

Parameter get_deposits :
context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
    Tezos_raw_protocol_alpha.Tez_repr.t.

extensible_type

Parameter check_gas_limit :
t ->
  Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.

Parameter set_gas_limit :
t -> Tezos_protocol_environment_alpha__Environment.Z.t -> t.

Parameter set_gas_unlimited : t -> t.

Parameter gas_level : t -> Tezos_raw_protocol_alpha.Gas_limit_repr.t.

Parameter gas_consumed :
t -> t -> Tezos_protocol_environment_alpha__Environment.Z.t.

Parameter block_gas_level :
t -> Tezos_protocol_environment_alpha__Environment.Z.t.

Parameter init_storage_space_to_pay : t -> t.

Parameter update_storage_space_to_pay :
t -> Tezos_protocol_environment_alpha__Environment.Z.t -> t.

Parameter update_allocated_contracts_count : t -> t.

Parameter clear_storage_space_to_pay :
t -> t * Tezos_protocol_environment_alpha__Environment.Z.t * Z.

extensible_type

Parameter init_origination_nonce :
t ->
  Tezos_protocol_environment_alpha__Environment.Operation_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
    -> t.

Parameter origination_nonce :
t ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    Tezos_raw_protocol_alpha.Contract_repr.origination_nonce.

Parameter increment_origination_nonce :
t ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (t * Tezos_raw_protocol_alpha.Contract_repr.origination_nonce).

Parameter unset_origination_nonce : t -> t.

Definition key := list string.

Definition value := Tezos_protocol_environment_alpha__Environment.MBytes.t.

module_type

include

Parameter reset_internal_nonce : context -> context.

Parameter fresh_internal_nonce :
context ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (context * Z).

Parameter record_internal_nonce : context -> Z -> context.

Parameter internal_nonce_already_recorded : context -> Z -> bool.

Parameter allowed_endorsements :
context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
    (Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
      list Z * bool).

Parameter included_endorsements : context -> Z.

Parameter init_endorsements :
context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.Map.t
    (Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t *
      list Z * bool) -> context.

Parameter record_endorsement :
context ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    context.

Parameter fresh_temporary_big_map :
context -> context * Tezos_protocol_environment_alpha__Environment.Z.t.

Parameter reset_temporary_big_map : context -> context.

Parameter temporary_big_maps : forall {a : Type},
context ->
  (a ->
    Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
    a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a.
raw_level_repr.ml 12 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = int32

type raw_level = t

include (Compare.Int32 : Compare.S with type t := t)

let encoding = Data_encoding.int32

let pp ppf level = Format.fprintf ppf "%ld" level

let rpc_arg =
  let construct raw_level = Int32.to_string raw_level in
  let destruct str =
    match Int32.of_string str with
    | exception _ ->
        Error "Cannot parse level"
    | raw_level ->
        Ok raw_level
  in
  RPC_arg.make
    ~descr:"A level integer"
    ~name:"block_level"
    ~construct
    ~destruct
    ()

let root = 0l

let succ = Int32.succ

let pred l = if l = 0l then None else Some (Int32.pred l)

let diff = Int32.sub

let to_int32 l = l

let of_int32_exn l =
  if Compare.Int32.(l >= 0l) then l else invalid_arg "Level_repr.of_int32"

type error += Unexpected_level of Int32.t (* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"unexpected_level"
    ~title:"Unexpected level"
    ~description:"Level must be non-negative."
    ~pp:(fun ppf l ->
      Format.fprintf
        ppf
        "The level is %s but should be non-negative."
        (Int32.to_string l))
    Data_encoding.(obj1 (req "level" int32))
    (function Unexpected_level l -> Some l | _ -> None)
    (fun l -> Unexpected_level l)

let of_int32 l = try Ok (of_int32_exn l) with _ -> error (Unexpected_level l)

module Index = struct
  type t = raw_level

  let path_length = 1

  let to_path level l = Int32.to_string level :: l

  let of_path = function
    | [s] -> (
      try Some (Int32.of_string s) with _ -> None )
    | _ ->
        None

  let rpc_arg = rpc_arg

  let encoding = encoding

  let compare = compare
end
raw_level_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition t := int32.

Definition raw_level := t.

Export Compare.Int32.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding int32 :=
  Data_encoding.int32.

Definition pp
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (level : int32) : unit :=
  Format.fprintf ppf
    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
      "%ld" % string) level.

Definition rpc_arg
  : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg int32 :=
  let construct (raw_level : int32) : string :=
    Int32.to_string raw_level in
  let destruct (str : string)
    : Tezos_protocol_environment_alpha__Environment.Pervasives.result int32
      string :=
    let 'raw_level := Int32.of_string str in
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok raw_level in
  RPC_arg.make (Some "A level integer" % string) "block_level" % string destruct
    construct tt.

Definition root : int32 :=
  (* ❌ Constant of type int32 is converted to int *)
  0.

Definition succ : int32 -> int32 := Int32.succ.

Definition pred (l : t) : option int32 :=
  if
    op_eq l
      (* ❌ Constant of type int32 is converted to int *)
      0 then
    None
  else
    Some (Int32.pred l).

Definition diff : int32 -> int32 -> int32 := Int32.sub.

Definition to_int32 {A : Type} (l : A) : A := l.

Definition of_int32_exn
  (l :
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.t) :=
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
      l
      (* ❌ Constant of type int32 is converted to int *)
      0 then
    l
  else
    invalid_arg "Level_repr.of_int32" % string.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "unexpected_level" % string "Unexpected level" % string
    "Level must be non-negative." % string
    (Some
      (fun ppf =>
        fun l =>
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "The level is " % string
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    " but should be non-negative." % string
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
              "The level is %s but should be non-negative." % string)
            (Int32.to_string l))) (obj1 (req None None "level" % string int32))
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_level
          l => Some l
      | _ => None
      end)
    (fun l =>
      Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_level
        l).

Definition of_int32
  (l :
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : Tezos_protocol_environment_alpha__Environment.Pervasives.result
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.t)
    (list Tezos_protocol_environment_alpha__Environment.Error_monad.error) :=
  (* ❌ Try-with are not handled *)
  try
    (Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
      (of_int32_exn l)).

Module Index.
  Definition t := raw_level.
  
  Definition path_length : Z := 1.
  
  Definition to_path (level : int32) (l : list string) : list string :=
    cons (Int32.to_string level) l.
  
  Definition of_path (function_parameter : list string) : option int32 :=
    match function_parameter with
    | cons s [] =>
      (* ❌ Try-with are not handled *)
      try (Some (Int32.of_string s))
    | _ => None
    end.
  
  Definition rpc_arg
    : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg int32 := rpc_arg.
  
  Definition encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding int32 :=
    encoding.
  
  Definition compare : t -> t -> Z := compare.
End Index.
raw_level_repr.mli 3 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** The shell's notion of a level: an integer indicating the number of blocks
    since genesis: genesis is 0, all other blocks have increasing levels from
    there. *)
type t

type raw_level = t

val encoding : raw_level Data_encoding.t

val rpc_arg : raw_level RPC_arg.arg

val pp : Format.formatter -> raw_level -> unit

include Compare.S with type t := raw_level

val to_int32 : raw_level -> int32

val of_int32_exn : int32 -> raw_level

val of_int32 : int32 -> raw_level tzresult

val diff : raw_level -> raw_level -> int32

val root : raw_level

val succ : raw_level -> raw_level

val pred : raw_level -> raw_level option

module Index : Storage_description.INDEX with type t = raw_level
raw_level_repr_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter t : Type.

Definition raw_level := t.

Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t raw_level.

Parameter rpc_arg :
Tezos_protocol_environment_alpha__Environment.RPC_arg.arg raw_level.

Parameter pp :
Tezos_protocol_environment_alpha__Environment.Format.formatter ->
  raw_level -> unit.

include

Parameter to_int32 : raw_level -> int32.

Parameter of_int32_exn : int32 -> raw_level.

Parameter of_int32 :
int32 ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult raw_level.

Parameter diff : raw_level -> raw_level -> int32.

Parameter root : raw_level.

Parameter succ : raw_level -> raw_level.

Parameter pred : raw_level -> option raw_level.

unhandled_module
roll_repr.ml 2 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

include Compare.Int32

type roll = t

let encoding = Data_encoding.int32

let first = 0l

let succ i = Int32.succ i

let random sequence ~bound = Seed_repr.take_int32 sequence bound

let rpc_arg = RPC_arg.like RPC_arg.int32 "roll"

let to_int32 v = v

module Index = struct
  type t = roll

  let path_length = 3

  let to_path roll l =
    (Int32.to_string @@ Int32.logand roll (Int32.of_int 0xff))
    :: ( Int32.to_string
       @@ Int32.logand (Int32.shift_right_logical roll 8) (Int32.of_int 0xff)
       )
    :: Int32.to_string roll :: l

  let of_path = function
    | _ :: _ :: s :: _ -> (
      try Some (Int32.of_string s) with _ -> None )
    | _ ->
        None

  let rpc_arg = rpc_arg

  let encoding = encoding

  let compare = compare
end
roll_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Export Compare.Int32.

Definition roll := t.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding int32 :=
  Data_encoding.int32.

Definition first : int32 :=
  (* ❌ Constant of type int32 is converted to int *)
  0.

Definition succ (i : int32) : int32 := Int32.succ i.

Definition random
  (sequence : Tezos_raw_protocol_alpha.Seed_repr.sequence) (bound : int32)
  : int32 * Tezos_raw_protocol_alpha.Seed_repr.sequence :=
  Seed_repr.take_int32 sequence bound.

Definition rpc_arg
  : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg int32 :=
  RPC_arg.like RPC_arg.int32 None "roll" % string.

Definition to_int32 {A : Type} (v : A) : A := v.

Module Index.
  Definition t := roll.
  
  Definition path_length : Z := 3.
  
  Definition to_path (roll : int32) (l : list string) : list string :=
    cons (op_atat Int32.to_string (Int32.logand roll (Int32.of_int 255)))
      (cons
        (op_atat Int32.to_string
          (Int32.logand (Int32.shift_right_logical roll 8) (Int32.of_int 255)))
        (cons (Int32.to_string roll) l)).
  
  Definition of_path (function_parameter : list string) : option int32 :=
    match function_parameter with
    | cons _ (cons _ (cons s _)) =>
      (* ❌ Try-with are not handled *)
      try (Some (Int32.of_string s))
    | _ => None
    end.
  
  Definition rpc_arg
    : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg int32 := rpc_arg.
  
  Definition encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding int32 :=
    encoding.
  
  Definition compare : t -> t -> Z := compare.
End Index.
roll_repr.mli 2 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = private int32

type roll = t

val encoding : roll Data_encoding.t

val rpc_arg : roll RPC_arg.t

val random : Seed_repr.sequence -> bound:roll -> roll * Seed_repr.sequence

val first : roll

val succ : roll -> roll

val to_int32 : roll -> Int32.t

val ( = ) : roll -> roll -> bool

module Index : Storage_description.INDEX with type t = roll
roll_repr_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition t := int32.

Definition roll := t.

Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t roll.

Parameter rpc_arg :
Tezos_protocol_environment_alpha__Environment.RPC_arg.t roll.

Parameter random :
Tezos_raw_protocol_alpha.Seed_repr.sequence ->
  roll -> roll * Tezos_raw_protocol_alpha.Seed_repr.sequence.

Parameter first : roll.

Parameter succ : roll -> roll.

Parameter to_int32 :
roll -> Tezos_protocol_environment_alpha__Environment.Int32.t.

Parameter op_eq : roll -> roll -> bool.

unhandled_module
roll_storage.ml 13 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Misc

type error +=
  | Consume_roll_change (* `Permanent *)
  | No_roll_for_delegate (* `Permanent *)
  | No_roll_snapshot_for_cycle of Cycle_repr.t (* `Permanent *)
  | Unregistered_delegate of Signature.Public_key_hash.t

(* `Permanent *)

let () =
  let open Data_encoding in
  (* Consume roll change *)
  register_error_kind
    `Permanent
    ~id:"contract.manager.consume_roll_change"
    ~title:"Consume roll change"
    ~description:"Change is not enough to consume a roll."
    ~pp:(fun ppf () ->
      Format.fprintf ppf "Not enough change to consume a roll.")
    empty
    (function Consume_roll_change -> Some () | _ -> None)
    (fun () -> Consume_roll_change) ;
  (* No roll for delegate *)
  register_error_kind
    `Permanent
    ~id:"contract.manager.no_roll_for_delegate"
    ~title:"No roll for delegate"
    ~description:"Delegate has no roll."
    ~pp:(fun ppf () -> Format.fprintf ppf "Delegate has no roll.")
    empty
    (function No_roll_for_delegate -> Some () | _ -> None)
    (fun () -> No_roll_for_delegate) ;
  (* No roll snapshot for cycle *)
  register_error_kind
    `Permanent
    ~id:"contract.manager.no_roll_snapshot_for_cycle"
    ~title:"No roll snapshot for cycle"
    ~description:
      "A snapshot of the rolls distribution does not exist for this cycle."
    ~pp:(fun ppf c ->
      Format.fprintf
        ppf
        "A snapshot of the rolls distribution does not exist for cycle %a"
        Cycle_repr.pp
        c)
    (obj1 (req "cycle" Cycle_repr.encoding))
    (function No_roll_snapshot_for_cycle c -> Some c | _ -> None)
    (fun c -> No_roll_snapshot_for_cycle c) ;
  (* Unregistered delegate *)
  register_error_kind
    `Permanent
    ~id:"contract.manager.unregistered_delegate"
    ~title:"Unregistered delegate"
    ~description:"A contract cannot be delegated to an unregistered delegate"
    ~pp:(fun ppf k ->
      Format.fprintf
        ppf
        "The provided public key (with hash %a) is  not registered as valid \
         delegate key."
        Signature.Public_key_hash.pp
        k)
    (obj1 (req "hash" Signature.Public_key_hash.encoding))
    (function Unregistered_delegate k -> Some k | _ -> None)
    (fun k -> Unregistered_delegate k)

let get_contract_delegate c contract =
  Storage.Contract.Delegate.get_option c contract

let delegate_pubkey ctxt delegate =
  Storage.Contract.Manager.get_option
    ctxt
    (Contract_repr.implicit_contract delegate)
  >>=? function
  | None | Some (Manager_repr.Hash _) ->
      fail (Unregistered_delegate delegate)
  | Some (Manager_repr.Public_key pk) ->
      return pk

let clear_cycle c cycle =
  Storage.Roll.Snapshot_for_cycle.get c cycle
  >>=? fun index ->
  Storage.Roll.Snapshot_for_cycle.delete c cycle
  >>=? fun c ->
  Storage.Roll.Last_for_snapshot.delete (c, cycle) index
  >>=? fun c ->
  Storage.Roll.Owner.delete_snapshot c (cycle, index) >>= fun c -> return c

let fold ctxt ~f init =
  Storage.Roll.Next.get ctxt
  >>=? fun last ->
  let rec loop ctxt roll acc =
    acc
    >>=? fun acc ->
    if Roll_repr.(roll = last) then return acc
    else
      Storage.Roll.Owner.get_option ctxt roll
      >>=? function
      | None ->
          loop ctxt (Roll_repr.succ roll) (return acc)
      | Some delegate ->
          loop ctxt (Roll_repr.succ roll) (f roll delegate acc)
  in
  loop ctxt Roll_repr.first (return init)

let snapshot_rolls_for_cycle ctxt cycle =
  Storage.Roll.Snapshot_for_cycle.get ctxt cycle
  >>=? fun index ->
  Storage.Roll.Snapshot_for_cycle.set ctxt cycle (index + 1)
  >>=? fun ctxt ->
  Storage.Roll.Owner.snapshot ctxt (cycle, index)
  >>=? fun ctxt ->
  Storage.Roll.Next.get ctxt
  >>=? fun last ->
  Storage.Roll.Last_for_snapshot.init (ctxt, cycle) index last
  >>=? fun ctxt -> return ctxt

let freeze_rolls_for_cycle ctxt cycle =
  Storage.Roll.Snapshot_for_cycle.get ctxt cycle
  >>=? fun max_index ->
  Storage.Seed.For_cycle.get ctxt cycle
  >>=? fun seed ->
  let rd = Seed_repr.initialize_new seed [MBytes.of_string "roll_snapshot"] in
  let seq = Seed_repr.sequence rd 0l in
  let selected_index =
    Seed_repr.take_int32 seq (Int32.of_int max_index) |> fst |> Int32.to_int
  in
  Storage.Roll.Snapshot_for_cycle.set ctxt cycle selected_index
  >>=? fun ctxt ->
  fold_left_s
    (fun ctxt index ->
      if Compare.Int.(index = selected_index) then return ctxt
      else
        Storage.Roll.Owner.delete_snapshot ctxt (cycle, index)
        >>= fun ctxt ->
        Storage.Roll.Last_for_snapshot.delete (ctxt, cycle) index
        >>=? fun ctxt -> return ctxt)
    ctxt
    Misc.(0 --> (max_index - 1))
  >>=? fun ctxt -> return ctxt

(* Roll selection *)

module Random = struct
  let int32_to_bytes i =
    let b = MBytes.create 4 in
    MBytes.set_int32 b 0 i ; b

  let level_random seed use level =
    let position = level.Level_repr.cycle_position in
    Seed_repr.initialize_new
      seed
      [MBytes.of_string ("level " ^ use ^ ":"); int32_to_bytes position]

  let owner c kind level offset =
    let cycle = level.Level_repr.cycle in
    Seed_storage.for_cycle c cycle
    >>=? fun random_seed ->
    let rd = level_random random_seed kind level in
    let sequence = Seed_repr.sequence rd (Int32.of_int offset) in
    Storage.Roll.Snapshot_for_cycle.get c cycle
    >>=? fun index ->
    Storage.Roll.Last_for_snapshot.get (c, cycle) index
    >>=? fun bound ->
    let rec loop sequence =
      let (roll, sequence) = Roll_repr.random sequence ~bound in
      Storage.Roll.Owner.Snapshot.get_option c ((cycle, index), roll)
      >>=? function None -> loop sequence | Some delegate -> return delegate
    in
    Storage.Roll.Owner.snapshot_exists c (cycle, index)
    >>= fun snapshot_exists ->
    fail_unless snapshot_exists (No_roll_snapshot_for_cycle cycle)
    >>=? fun () -> loop sequence
end

let baking_rights_owner c level ~priority =
  Random.owner c "baking" level priority

let endorsement_rights_owner c level ~slot =
  Random.owner c "endorsement" level slot

let traverse_rolls ctxt head =
  let rec loop acc roll =
    Storage.Roll.Successor.get_option ctxt roll
    >>=? function
    | None -> return (List.rev acc) | Some next -> loop (next :: acc) next
  in
  loop [head] head

let get_rolls ctxt delegate =
  Storage.Roll.Delegate_roll_list.get_option ctxt delegate
  >>=? function
  | None -> return_nil | Some head_roll -> traverse_rolls ctxt head_roll

let count_rolls ctxt delegate =
  Storage.Roll.Delegate_roll_list.get_option ctxt delegate
  >>=? function
  | None ->
      return 0
  | Some head_roll ->
      let rec loop acc roll =
        Storage.Roll.Successor.get_option ctxt roll
        >>=? function None -> return acc | Some next -> loop (succ acc) next
      in
      loop 1 head_roll

let get_change c delegate =
  Storage.Roll.Delegate_change.get_option c delegate
  >>=? function None -> return Tez_repr.zero | Some change -> return change

module Delegate = struct
  let fresh_roll c =
    Storage.Roll.Next.get c
    >>=? fun roll ->
    Storage.Roll.Next.set c (Roll_repr.succ roll) >>=? fun c -> return (roll, c)

  let get_limbo_roll c =
    Storage.Roll.Limbo.get_option c
    >>=? function
    | None ->
        fresh_roll c
        >>=? fun (roll, c) ->
        Storage.Roll.Limbo.init c roll >>=? fun c -> return (roll, c)
    | Some roll ->
        return (roll, c)

  let consume_roll_change c delegate =
    let tokens_per_roll = Constants_storage.tokens_per_roll c in
    Storage.Roll.Delegate_change.get c delegate
    >>=? fun change ->
    trace Consume_roll_change (Lwt.return Tez_repr.(change -? tokens_per_roll))
    >>=? fun new_change ->
    Storage.Roll.Delegate_change.set c delegate new_change

  let recover_roll_change c delegate =
    let tokens_per_roll = Constants_storage.tokens_per_roll c in
    Storage.Roll.Delegate_change.get c delegate
    >>=? fun change ->
    Lwt.return Tez_repr.(change +? tokens_per_roll)
    >>=? fun new_change ->
    Storage.Roll.Delegate_change.set c delegate new_change

  let pop_roll_from_delegate c delegate =
    recover_roll_change c delegate
    >>=? fun c ->
    (* beginning:
       delegate : roll -> successor_roll -> ...
       limbo : limbo_head -> ...
    *)
    Storage.Roll.Limbo.get_option c
    >>=? fun limbo_head ->
    Storage.Roll.Delegate_roll_list.get_option c delegate
    >>=? function
    | None ->
        fail No_roll_for_delegate
    | Some roll ->
        Storage.Roll.Owner.delete c roll
        >>=? fun c ->
        Storage.Roll.Successor.get_option c roll
        >>=? fun successor_roll ->
        Storage.Roll.Delegate_roll_list.set_option c delegate successor_roll
        >>= fun c ->
        (* delegate : successor_roll -> ...
           roll ------^
           limbo : limbo_head -> ... *)
        Storage.Roll.Successor.set_option c roll limbo_head
        >>= fun c ->
        (* delegate : successor_roll -> ...
           roll ------v
           limbo : limbo_head -> ... *)
        Storage.Roll.Limbo.init_set c roll
        >>= fun c ->
        (* delegate : successor_roll -> ...
           limbo : roll -> limbo_head -> ... *)
        return (roll, c)

  let create_roll_in_delegate c delegate delegate_pk =
    consume_roll_change c delegate
    >>=? fun c ->
    (* beginning:
       delegate : delegate_head -> ...
       limbo : roll -> limbo_successor -> ...
    *)
    Storage.Roll.Delegate_roll_list.get_option c delegate
    >>=? fun delegate_head ->
    get_limbo_roll c
    >>=? fun (roll, c) ->
    Storage.Roll.Owner.init c roll delegate_pk
    >>=? fun c ->
    Storage.Roll.Successor.get_option c roll
    >>=? fun limbo_successor ->
    Storage.Roll.Limbo.set_option c limbo_successor
    >>= fun c ->
    (* delegate : delegate_head -> ...
       roll ------v
       limbo : limbo_successor -> ... *)
    Storage.Roll.Successor.set_option c roll delegate_head
    >>= fun c ->
    (* delegate : delegate_head -> ...
       roll ------^
       limbo : limbo_successor -> ... *)
    Storage.Roll.Delegate_roll_list.init_set c delegate roll
    >>= fun c ->
    (* delegate : roll -> delegate_head -> ...
       limbo : limbo_successor -> ... *)
    return c

  let ensure_inited c delegate =
    Storage.Roll.Delegate_change.mem c delegate
    >>= function
    | true ->
        return c
    | false ->
        Storage.Roll.Delegate_change.init c delegate Tez_repr.zero

  let is_inactive c delegate =
    Storage.Contract.Inactive_delegate.mem
      c
      (Contract_repr.implicit_contract delegate)
    >>= fun inactive ->
    if inactive then return inactive
    else
      Storage.Contract.Delegate_desactivation.get_option
        c
        (Contract_repr.implicit_contract delegate)
      >>=? function
      | Some last_active_cycle ->
          let {Level_repr.cycle = current_cycle} =
            Raw_context.current_level c
          in
          return Cycle_repr.(last_active_cycle < current_cycle)
      | None ->
          (* This case is only when called from `set_active`, when creating
             a contract. *)
          return_false

  let add_amount c delegate amount =
    ensure_inited c delegate
    >>=? fun c ->
    let tokens_per_roll = Constants_storage.tokens_per_roll c in
    Storage.Roll.Delegate_change.get c delegate
    >>=? fun change ->
    Lwt.return Tez_repr.(amount +? change)
    >>=? fun change ->
    Storage.Roll.Delegate_change.set c delegate change
    >>=? fun c ->
    delegate_pubkey c delegate
    >>=? fun delegate_pk ->
    let rec loop c change =
      if Tez_repr.(change < tokens_per_roll) then return c
      else
        Lwt.return Tez_repr.(change -? tokens_per_roll)
        >>=? fun change ->
        create_roll_in_delegate c delegate delegate_pk
        >>=? fun c -> loop c change
    in
    is_inactive c delegate
    >>=? fun inactive ->
    if inactive then return c
    else
      loop c change
      >>=? fun c ->
      Storage.Roll.Delegate_roll_list.get_option c delegate
      >>=? fun rolls ->
      match rolls with
      | None ->
          return c
      | Some _ ->
          Storage.Active_delegates_with_rolls.add c delegate
          >>= fun c -> return c

  let remove_amount c delegate amount =
    let tokens_per_roll = Constants_storage.tokens_per_roll c in
    let rec loop c change =
      if Tez_repr.(amount <= change) then return (c, change)
      else
        pop_roll_from_delegate c delegate
        >>=? fun (_, c) ->
        Lwt.return Tez_repr.(change +? tokens_per_roll)
        >>=? fun change -> loop c change
    in
    Storage.Roll.Delegate_change.get c delegate
    >>=? fun change ->
    is_inactive c delegate
    >>=? fun inactive ->
    ( if inactive then return (c, change)
    else
      loop c change
      >>=? fun (c, change) ->
      Storage.Roll.Delegate_roll_list.get_option c delegate
      >>=? fun rolls ->
      match rolls with
      | None ->
          Storage.Active_delegates_with_rolls.del c delegate
          >>= fun c -> return (c, change)
      | Some _ ->
          return (c, change) )
    >>=? fun (c, change) ->
    Lwt.return Tez_repr.(change -? amount)
    >>=? fun change -> Storage.Roll.Delegate_change.set c delegate change

  let set_inactive ctxt delegate =
    ensure_inited ctxt delegate
    >>=? fun ctxt ->
    let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in
    Storage.Roll.Delegate_change.get ctxt delegate
    >>=? fun change ->
    Storage.Contract.Inactive_delegate.add
      ctxt
      (Contract_repr.implicit_contract delegate)
    >>= fun ctxt ->
    Storage.Active_delegates_with_rolls.del ctxt delegate
    >>= fun ctxt ->
    let rec loop ctxt change =
      Storage.Roll.Delegate_roll_list.get_option ctxt delegate
      >>=? function
      | None ->
          return (ctxt, change)
      | Some _roll ->
          pop_roll_from_delegate ctxt delegate
          >>=? fun (_, ctxt) ->
          Lwt.return Tez_repr.(change +? tokens_per_roll)
          >>=? fun change -> loop ctxt change
    in
    loop ctxt change
    >>=? fun (ctxt, change) ->
    Storage.Roll.Delegate_change.set ctxt delegate change
    >>=? fun ctxt -> return ctxt

  let set_active ctxt delegate =
    is_inactive ctxt delegate
    >>=? fun inactive ->
    let current_cycle = (Raw_context.current_level ctxt).cycle in
    let preserved_cycles = Constants_storage.preserved_cycles ctxt in
    (* When the delegate is new or inactive, she will become active in
       `1+preserved_cycles`, and we allow `preserved_cycles` for the
       delegate to start baking. When the delegate is active, we only
       give her at least `preserved_cycles` after the current cycle
       before to be deactivated.  *)
    Storage.Contract.Delegate_desactivation.get_option
      ctxt
      (Contract_repr.implicit_contract delegate)
    >>=? fun current_expiration ->
    let expiration =
      match current_expiration with
      | None ->
          Cycle_repr.add current_cycle (1 + (2 * preserved_cycles))
      | Some current_expiration ->
          let delay =
            if inactive then 1 + (2 * preserved_cycles)
            else 1 + preserved_cycles
          in
          let updated = Cycle_repr.add current_cycle delay in
          Cycle_repr.max current_expiration updated
    in
    Storage.Contract.Delegate_desactivation.init_set
      ctxt
      (Contract_repr.implicit_contract delegate)
      expiration
    >>= fun ctxt ->
    if not inactive then return ctxt
    else
      ensure_inited ctxt delegate
      >>=? fun ctxt ->
      let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in
      Storage.Roll.Delegate_change.get ctxt delegate
      >>=? fun change ->
      Storage.Contract.Inactive_delegate.del
        ctxt
        (Contract_repr.implicit_contract delegate)
      >>= fun ctxt ->
      delegate_pubkey ctxt delegate
      >>=? fun delegate_pk ->
      let rec loop ctxt change =
        if Tez_repr.(change < tokens_per_roll) then return ctxt
        else
          Lwt.return Tez_repr.(change -? tokens_per_roll)
          >>=? fun change ->
          create_roll_in_delegate ctxt delegate delegate_pk
          >>=? fun ctxt -> loop ctxt change
      in
      loop ctxt change
      >>=? fun ctxt ->
      Storage.Roll.Delegate_roll_list.get_option ctxt delegate
      >>=? fun rolls ->
      match rolls with
      | None ->
          return ctxt
      | Some _ ->
          Storage.Active_delegates_with_rolls.add ctxt delegate
          >>= fun ctxt -> return ctxt
end

module Contract = struct
  let add_amount c contract amount =
    get_contract_delegate c contract
    >>=? function
    | None -> return c | Some delegate -> Delegate.add_amount c delegate amount

  let remove_amount c contract amount =
    get_contract_delegate c contract
    >>=? function
    | None ->
        return c
    | Some delegate ->
        Delegate.remove_amount c delegate amount
end

let init ctxt = Storage.Roll.Next.init ctxt Roll_repr.first

let init_first_cycles ctxt =
  let preserved = Constants_storage.preserved_cycles ctxt in
  (* Precompute rolls for cycle (0 --> preserved_cycles) *)
  List.fold_left
    (fun ctxt c ->
      ctxt
      >>=? fun ctxt ->
      let cycle = Cycle_repr.of_int32_exn (Int32.of_int c) in
      Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0
      >>=? fun ctxt ->
      snapshot_rolls_for_cycle ctxt cycle
      >>=? fun ctxt -> freeze_rolls_for_cycle ctxt cycle)
    (return ctxt)
    (0 --> preserved)
  >>=? fun ctxt ->
  let cycle = Cycle_repr.of_int32_exn (Int32.of_int (preserved + 1)) in
  (* Precomputed a snapshot for cycle (preserved_cycles + 1) *)
  Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0
  >>=? fun ctxt ->
  snapshot_rolls_for_cycle ctxt cycle
  >>=? fun ctxt ->
  (* Prepare storage for storing snapshots for cycle (preserved_cycles+2) *)
  let cycle = Cycle_repr.of_int32_exn (Int32.of_int (preserved + 2)) in
  Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0
  >>=? fun ctxt -> return ctxt

let snapshot_rolls ctxt =
  let current_level = Raw_context.current_level ctxt in
  let preserved = Constants_storage.preserved_cycles ctxt in
  let cycle = Cycle_repr.add current_level.cycle (preserved + 2) in
  snapshot_rolls_for_cycle ctxt cycle

let cycle_end ctxt last_cycle =
  let preserved = Constants_storage.preserved_cycles ctxt in
  ( match Cycle_repr.sub last_cycle preserved with
  | None ->
      return ctxt
  | Some cleared_cycle ->
      clear_cycle ctxt cleared_cycle )
  >>=? fun ctxt ->
  let frozen_roll_cycle = Cycle_repr.add last_cycle (preserved + 1) in
  freeze_rolls_for_cycle ctxt frozen_roll_cycle
  >>=? fun ctxt ->
  Storage.Roll.Snapshot_for_cycle.init
    ctxt
    (Cycle_repr.succ (Cycle_repr.succ frozen_roll_cycle))
    0
  >>=? fun ctxt -> return ctxt

let update_tokens_per_roll ctxt new_tokens_per_roll =
  let constants = Raw_context.constants ctxt in
  let old_tokens_per_roll = constants.tokens_per_roll in
  Raw_context.patch_constants ctxt (fun constants ->
      {constants with Constants_repr.tokens_per_roll = new_tokens_per_roll})
  >>= fun ctxt ->
  let decrease = Tez_repr.(new_tokens_per_roll < old_tokens_per_roll) in
  ( if decrease then
    Lwt.return Tez_repr.(old_tokens_per_roll -? new_tokens_per_roll)
  else Lwt.return Tez_repr.(new_tokens_per_roll -? old_tokens_per_roll) )
  >>=? fun abs_diff ->
  Storage.Delegates.fold ctxt (Ok ctxt) (fun pkh ctxt ->
      Lwt.return ctxt
      >>=? fun ctxt ->
      count_rolls ctxt pkh
      >>=? fun rolls ->
      Lwt.return Tez_repr.(abs_diff *? Int64.of_int rolls)
      >>=? fun amount ->
      if decrease then Delegate.add_amount ctxt pkh amount
      else Delegate.remove_amount ctxt pkh amount)
roll_storage_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Misc.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.manager.consume_roll_change" % string
      "Consume roll change" % string
      "Change is not enough to consume a roll." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Not enough change to consume a roll." % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Not enough change to consume a roll." % string))) empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Consume_roll_change
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Consume_roll_change)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.manager.no_roll_for_delegate" % string
      "No roll for delegate" % string "Delegate has no roll." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Delegate has no roll." % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Delegate has no roll." % string))) empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.No_roll_for_delegate
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.No_roll_for_delegate)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "contract.manager.no_roll_snapshot_for_cycle" % string
      "No roll snapshot for cycle" % string
      "A snapshot of the rolls distribution does not exist for this cycle." %
        string
      (Some
        (fun ppf =>
          fun c =>
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "A snapshot of the rolls distribution does not exist for cycle "
                    % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))
                "A snapshot of the rolls distribution does not exist for cycle %a"
                  % string) Cycle_repr.pp c))
      (obj1 (req None None "cycle" % string Cycle_repr.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.No_roll_snapshot_for_cycle
            c => Some c
        | _ => None
        end)
      (fun c =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.No_roll_snapshot_for_cycle
          c) in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "contract.manager.unregistered_delegate" % string
    "Unregistered delegate" % string
    "A contract cannot be delegated to an unregistered delegate" % string
    (Some
      (fun ppf =>
        fun k =>
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "The provided public key (with hash " % string
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    ") is  not registered as valid delegate key." % string
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
              "The provided public key (with hash %a) is  not registered as valid delegate key."
                % string) Signature.Public_key_hash.pp k))
    (obj1 (req None None "hash" % string Signature.Public_key_hash.encoding))
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unregistered_delegate
          k => Some k
      | _ => None
      end)
    (fun k =>
      Tezos_protocol_environment_alpha__Environment.Error_monad.Unregistered_delegate
        k).

Definition get_contract_delegate
  (c : Tezos_raw_protocol_alpha.Storage.Contract.Delegate.context)
  (contract : Tezos_raw_protocol_alpha.Storage.Contract.Delegate.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Storage.Contract.Delegate.value)) :=
  Storage.Contract.Delegate.get_option c contract.

Definition delegate_pubkey
  (ctxt : Tezos_raw_protocol_alpha.Storage.Contract.Manager.context)
  (delegate :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t) :=
  op_gtgteqquestion
    (Storage.Contract.Manager.get_option ctxt
      (Contract_repr.implicit_contract delegate))
    (fun function_parameter =>
      match function_parameter with
      | None | Some (Tezos_raw_protocol_alpha.Manager_repr.Hash _) =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Unregistered_delegate
            delegate)
      | Some (Tezos_raw_protocol_alpha.Manager_repr.Public_key pk) =>
        __return pk
      end).

Definition clear_cycle
  (c : Tezos_raw_protocol_alpha.Storage.Roll.Snapshot_for_cycle.context)
  (cycle : Tezos_raw_protocol_alpha.Storage.Roll.Snapshot_for_cycle.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteqquestion (Storage.Roll.Snapshot_for_cycle.get c cycle)
    (fun index =>
      op_gtgteqquestion (Storage.Roll.Snapshot_for_cycle.delete c cycle)
        (fun c =>
          op_gtgteqquestion
            (Storage.Roll.Last_for_snapshot.delete (c, cycle) index)
            (fun c =>
              op_gtgteq (Storage.Roll.Owner.delete_snapshot c (cycle, index))
                (fun c => __return c)))).

Definition fold {A : Type}
  (ctxt : Tezos_raw_protocol_alpha.Storage.Roll.Next.context)
  (f :
    Tezos_raw_protocol_alpha.Roll_repr.roll ->
      Tezos_raw_protocol_alpha.Storage.Roll.Owner.value ->
        A ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              A)) (init : A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  op_gtgteqquestion (Storage.Roll.Next.get ctxt)
    (fun last =>
      let fix loop
        (ctxt : Tezos_raw_protocol_alpha.Storage.Roll.Owner.context) (roll :
        Tezos_raw_protocol_alpha.Roll_repr.roll) (acc :
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A))
        : Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
        op_gtgteqquestion acc
          (fun acc =>
            if op_eq roll last then
              __return acc
            else
              op_gtgteqquestion (Storage.Roll.Owner.get_option ctxt roll)
                (fun function_parameter =>
                  match function_parameter with
                  | None => loop ctxt (Roll_repr.succ roll) (__return acc)
                  | Some delegate =>
                    loop ctxt (Roll_repr.succ roll) (f roll delegate acc)
                  end)) in
      loop ctxt Roll_repr.first (__return init)).

Definition snapshot_rolls_for_cycle
  (ctxt : Tezos_raw_protocol_alpha.Storage.Roll.Snapshot_for_cycle.context)
  (cycle : Tezos_raw_protocol_alpha.Storage.Roll.Snapshot_for_cycle.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteqquestion (Storage.Roll.Snapshot_for_cycle.get ctxt cycle)
    (fun index =>
      op_gtgteqquestion
        (Storage.Roll.Snapshot_for_cycle.set ctxt cycle (op_plus index 1))
        (fun ctxt =>
          op_gtgteqquestion (Storage.Roll.Owner.snapshot ctxt (cycle, index))
            (fun ctxt =>
              op_gtgteqquestion (Storage.Roll.Next.get ctxt)
                (fun last =>
                  op_gtgteqquestion
                    (Storage.Roll.Last_for_snapshot.init (ctxt, cycle) index
                      last) (fun ctxt => __return ctxt))))).

Definition freeze_rolls_for_cycle
  (ctxt : Tezos_raw_protocol_alpha.Storage.Roll.Snapshot_for_cycle.context)
  (cycle : Tezos_raw_protocol_alpha.Storage.Roll.Snapshot_for_cycle.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Roll.Owner.context) :=
  op_gtgteqquestion (Storage.Roll.Snapshot_for_cycle.get ctxt cycle)
    (fun max_index =>
      op_gtgteqquestion (Storage.Seed.For_cycle.get ctxt cycle)
        (fun seed =>
          let rd :=
            Seed_repr.initialize_new seed
              (cons (MBytes.of_string "roll_snapshot" % string) []) in
          let seq :=
            Seed_repr.sequence rd
              (* ❌ Constant of type int32 is converted to int *)
              0 in
          let selected_index :=
            op_pipegt
              (op_pipegt (Seed_repr.take_int32 seq (Int32.of_int max_index)) fst)
              Int32.to_int in
          op_gtgteqquestion
            (Storage.Roll.Snapshot_for_cycle.set ctxt cycle selected_index)
            (fun ctxt =>
              op_gtgteqquestion
                (fold_left_s
                  (fun ctxt =>
                    fun index =>
                      if
                        Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
                          index selected_index then
                        __return ctxt
                      else
                        op_gtgteq
                          (Storage.Roll.Owner.delete_snapshot ctxt
                            (cycle, index))
                          (fun ctxt =>
                            op_gtgteqquestion
                              (Storage.Roll.Last_for_snapshot.delete
                                (ctxt, cycle) index) (fun ctxt => __return ctxt)))
                  ctxt (op_minusminusgt 0 (op_minus max_index 1)))
                (fun ctxt => __return ctxt)))).

Module Random.
  Definition int32_to_bytes (i : int32)
    : Tezos_protocol_environment_alpha__Environment.MBytes.t :=
    let b := MBytes.create 4 in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ := MBytes.set_int32 b 0 i in
    b.
  
  Definition level_random
    (seed : Tezos_raw_protocol_alpha.Seed_repr.seed) (use : string)
    (level : Tezos_raw_protocol_alpha.Level_repr.t)
    : Tezos_raw_protocol_alpha.Seed_repr.t :=
    let position := Level_repr.cycle_position level in
    Seed_repr.initialize_new seed
      (cons
        (MBytes.of_string
          (op_caret "level " % string (op_caret use ":" % string)))
        (cons (int32_to_bytes position) [])).
  
  Definition owner
    (c : Tezos_raw_protocol_alpha.Raw_context.t) (kind : string)
    (level : Tezos_raw_protocol_alpha.Level_repr.t) (offset : Z)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Storage.Roll.Owner.Snapshot.value) :=
    let cycle := Level_repr.cycle level in
    op_gtgteqquestion (Seed_storage.for_cycle c cycle)
      (fun random_seed =>
        let rd := level_random random_seed kind level in
        let sequence := Seed_repr.sequence rd (Int32.of_int offset) in
        op_gtgteqquestion (Storage.Roll.Snapshot_for_cycle.get c cycle)
          (fun index =>
            op_gtgteqquestion
              (Storage.Roll.Last_for_snapshot.get (c, cycle) index)
              (fun bound =>
                let fix loop
                  (sequence : Tezos_raw_protocol_alpha.Seed_repr.sequence)
                  : Tezos_protocol_environment_alpha__Environment.Lwt.t
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                      Tezos_raw_protocol_alpha.Storage.Roll.Owner.Snapshot.value) :=
                  let '(roll, sequence) := Roll_repr.random sequence bound in
                  op_gtgteqquestion
                    (Storage.Roll.Owner.Snapshot.get_option c
                      ((cycle, index), roll))
                    (fun function_parameter =>
                      match function_parameter with
                      | None => loop sequence
                      | Some delegate => __return delegate
                      end) in
                op_gtgteq (Storage.Roll.Owner.snapshot_exists c (cycle, index))
                  (fun snapshot_exists =>
                    op_gtgteqquestion
                      (fail_unless snapshot_exists
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.No_roll_snapshot_for_cycle
                          cycle))
                      (fun function_parameter =>
                        let 'tt := function_parameter in
                        loop sequence))))).
End Random.

Definition baking_rights_owner
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  (level : Tezos_raw_protocol_alpha.Level_repr.t) (priority : Z)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Roll.Owner.Snapshot.value) :=
  Random.owner c "baking" % string level priority.

Definition endorsement_rights_owner
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  (level : Tezos_raw_protocol_alpha.Level_repr.t) (slot : Z)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Roll.Owner.Snapshot.value) :=
  Random.owner c "endorsement" % string level slot.

Definition traverse_rolls
  (ctxt : Tezos_raw_protocol_alpha.Storage.Roll.Successor.context)
  (head : Tezos_raw_protocol_alpha.Storage.Roll.Successor.value)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list Tezos_raw_protocol_alpha.Storage.Roll.Successor.value)) :=
  let fix loop
    (acc : list Tezos_raw_protocol_alpha.Storage.Roll.Successor.value) (roll :
    Tezos_raw_protocol_alpha.Storage.Roll.Successor.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (list Tezos_raw_protocol_alpha.Storage.Roll.Successor.value)) :=
    op_gtgteqquestion (Storage.Roll.Successor.get_option ctxt roll)
      (fun function_parameter =>
        match function_parameter with
        | None => __return (List.rev acc)
        | Some next => loop (cons next acc) next
        end) in
  loop (cons head []) head.

Definition get_rolls
  (ctxt : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_roll_list.context)
  (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_roll_list.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list Tezos_raw_protocol_alpha.Storage.Roll.Successor.value)) :=
  op_gtgteqquestion (Storage.Roll.Delegate_roll_list.get_option ctxt delegate)
    (fun function_parameter =>
      match function_parameter with
      | None => return_nil
      | Some head_roll => traverse_rolls ctxt head_roll
      end).

Definition count_rolls
  (ctxt : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_roll_list.context)
  (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_roll_list.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z) :=
  op_gtgteqquestion (Storage.Roll.Delegate_roll_list.get_option ctxt delegate)
    (fun function_parameter =>
      match function_parameter with
      | None => __return 0
      | Some head_roll =>
        let fix loop
          (acc : Z) (roll : Tezos_raw_protocol_alpha.Storage.Roll.Successor.key)
          : Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              Z) :=
          op_gtgteqquestion (Storage.Roll.Successor.get_option ctxt roll)
            (fun function_parameter =>
              match function_parameter with
              | None => __return acc
              | Some next => loop (succ acc) next
              end) in
        loop 1 head_roll
      end).

Definition get_change
  (c : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.context)
  (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Tez_repr.t) :=
  op_gtgteqquestion (Storage.Roll.Delegate_change.get_option c delegate)
    (fun function_parameter =>
      match function_parameter with
      | None => __return Tez_repr.zero
      | Some change => __return change
      end).

Module Delegate.
  Definition fresh_roll (c : Tezos_raw_protocol_alpha.Storage.Roll.Next.context)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Storage.Roll.Next.value *
          Tezos_raw_protocol_alpha.Raw_context.t)) :=
    op_gtgteqquestion (Storage.Roll.Next.get c)
      (fun roll =>
        op_gtgteqquestion (Storage.Roll.Next.set c (Roll_repr.succ roll))
          (fun c => __return (roll, c))).
  
  Definition get_limbo_roll
    (c : Tezos_raw_protocol_alpha.Storage.Roll.Limbo.context)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Storage.Roll.Next.value *
          Tezos_raw_protocol_alpha.Raw_context.t)) :=
    op_gtgteqquestion (Storage.Roll.Limbo.get_option c)
      (fun function_parameter =>
        match function_parameter with
        | None =>
          op_gtgteqquestion (fresh_roll c)
            (fun function_parameter =>
              let '(roll, c) := function_parameter in
              op_gtgteqquestion (Storage.Roll.Limbo.init c roll)
                (fun c => __return (roll, c)))
        | Some roll => __return (roll, c)
        end).
  
  Definition consume_roll_change
    (c : Tezos_raw_protocol_alpha.Raw_context.context)
    (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t) :=
    let tokens_per_roll := Constants_storage.tokens_per_roll c in
    op_gtgteqquestion (Storage.Roll.Delegate_change.get c delegate)
      (fun change =>
        op_gtgteqquestion
          (trace
            Tezos_protocol_environment_alpha__Environment.Error_monad.Consume_roll_change
            (Lwt.__return (op_minusquestion change tokens_per_roll)))
          (fun new_change =>
            Storage.Roll.Delegate_change.set c delegate new_change)).
  
  Definition recover_roll_change
    (c : Tezos_raw_protocol_alpha.Raw_context.context)
    (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t) :=
    let tokens_per_roll := Constants_storage.tokens_per_roll c in
    op_gtgteqquestion (Storage.Roll.Delegate_change.get c delegate)
      (fun change =>
        op_gtgteqquestion
          (Lwt.__return (op_plusquestion change tokens_per_roll))
          (fun new_change =>
            Storage.Roll.Delegate_change.set c delegate new_change)).
  
  Definition pop_roll_from_delegate
    (c : Tezos_raw_protocol_alpha.Raw_context.context)
    (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Storage.Roll.Delegate_roll_list.value *
          Tezos_raw_protocol_alpha.Raw_context.t)) :=
    op_gtgteqquestion (recover_roll_change c delegate)
      (fun c =>
        op_gtgteqquestion (Storage.Roll.Limbo.get_option c)
          (fun limbo_head =>
            op_gtgteqquestion
              (Storage.Roll.Delegate_roll_list.get_option c delegate)
              (fun function_parameter =>
                match function_parameter with
                | None =>
                  fail
                    Tezos_protocol_environment_alpha__Environment.Error_monad.No_roll_for_delegate
                | Some roll =>
                  op_gtgteqquestion (Storage.Roll.Owner.delete c roll)
                    (fun c =>
                      op_gtgteqquestion
                        (Storage.Roll.Successor.get_option c roll)
                        (fun successor_roll =>
                          op_gtgteq
                            (Storage.Roll.Delegate_roll_list.set_option c
                              delegate successor_roll)
                            (fun c =>
                              op_gtgteq
                                (Storage.Roll.Successor.set_option c roll
                                  limbo_head)
                                (fun c =>
                                  op_gtgteq (Storage.Roll.Limbo.init_set c roll)
                                    (fun c => __return (roll, c))))))
                end))).
  
  Definition create_roll_in_delegate
    (c : Tezos_raw_protocol_alpha.Raw_context.context)
    (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.key)
    (delegate_pk : Tezos_raw_protocol_alpha.Storage.Roll.Owner.value)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t) :=
    op_gtgteqquestion (consume_roll_change c delegate)
      (fun c =>
        op_gtgteqquestion
          (Storage.Roll.Delegate_roll_list.get_option c delegate)
          (fun delegate_head =>
            op_gtgteqquestion (get_limbo_roll c)
              (fun function_parameter =>
                let '(roll, c) := function_parameter in
                op_gtgteqquestion (Storage.Roll.Owner.init c roll delegate_pk)
                  (fun c =>
                    op_gtgteqquestion (Storage.Roll.Successor.get_option c roll)
                      (fun limbo_successor =>
                        op_gtgteq
                          (Storage.Roll.Limbo.set_option c limbo_successor)
                          (fun c =>
                            op_gtgteq
                              (Storage.Roll.Successor.set_option c roll
                                delegate_head)
                              (fun c =>
                                op_gtgteq
                                  (Storage.Roll.Delegate_roll_list.init_set c
                                    delegate roll) (fun c => __return c)))))))).
  
  Definition ensure_inited
    (c : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.context)
    (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.context) :=
    op_gtgteq (Storage.Roll.Delegate_change.mem c delegate)
      (fun function_parameter =>
        match function_parameter with
        | true => __return c
        | false => Storage.Roll.Delegate_change.init c delegate Tez_repr.zero
        end).
  
  Definition is_inactive
    (c : Tezos_raw_protocol_alpha.Storage.Contract.Inactive_delegate.context)
    (delegate :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool) :=
    op_gtgteq
      (Storage.Contract.Inactive_delegate.mem c
        (Contract_repr.implicit_contract delegate))
      (fun inactive =>
        if inactive then
          __return inactive
        else
          op_gtgteqquestion
            (Storage.Contract.Delegate_desactivation.get_option c
              (Contract_repr.implicit_contract delegate))
            (fun function_parameter =>
              match function_parameter with
              | Some last_active_cycle =>
                let '{| Level_repr.cycle := current_cycle |} :=
                  Raw_context.current_level c in
                __return (op_lt last_active_cycle current_cycle)
              | None => return_false
              end)).
  
  Definition add_amount
    (c : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.context)
    (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.key)
    (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t) :=
    op_gtgteqquestion (ensure_inited c delegate)
      (fun c =>
        let tokens_per_roll := Constants_storage.tokens_per_roll c in
        op_gtgteqquestion (Storage.Roll.Delegate_change.get c delegate)
          (fun change =>
            op_gtgteqquestion (Lwt.__return (op_plusquestion amount change))
              (fun change =>
                op_gtgteqquestion
                  (Storage.Roll.Delegate_change.set c delegate change)
                  (fun c =>
                    op_gtgteqquestion (delegate_pubkey c delegate)
                      (fun delegate_pk =>
                        let fix loop
                          (c : Tezos_raw_protocol_alpha.Raw_context.context)
                          (change : Tezos_raw_protocol_alpha.Tez_repr.t)
                          : Tezos_protocol_environment_alpha__Environment.Lwt.t
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                              Tezos_raw_protocol_alpha.Raw_context.context) :=
                          if op_lt change tokens_per_roll then
                            __return c
                          else
                            op_gtgteqquestion
                              (Lwt.__return
                                (op_minusquestion change tokens_per_roll))
                              (fun change =>
                                op_gtgteqquestion
                                  (create_roll_in_delegate c delegate
                                    delegate_pk) (fun c => loop c change)) in
                        op_gtgteqquestion (is_inactive c delegate)
                          (fun inactive =>
                            if inactive then
                              __return c
                            else
                              op_gtgteqquestion (loop c change)
                                (fun c =>
                                  op_gtgteqquestion
                                    (Storage.Roll.Delegate_roll_list.get_option
                                      c delegate)
                                    (fun rolls =>
                                      match rolls with
                                      | None => __return c
                                      | Some _ =>
                                        op_gtgteq
                                          (Storage.Active_delegates_with_rolls.add
                                            c delegate) (fun c => __return c)
                                      end)))))))).
  
  Definition remove_amount
    (c : Tezos_raw_protocol_alpha.Raw_context.context)
    (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.key)
    (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t) :=
    let tokens_per_roll := Constants_storage.tokens_per_roll c in
    let fix loop
      (c : Tezos_raw_protocol_alpha.Raw_context.context) (change :
      Tezos_raw_protocol_alpha.Tez_repr.t)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.context *
            Tezos_raw_protocol_alpha.Tez_repr.t)) :=
      if op_lteq amount change then
        __return (c, change)
      else
        op_gtgteqquestion (pop_roll_from_delegate c delegate)
          (fun function_parameter =>
            let '(_, c) := function_parameter in
            op_gtgteqquestion
              (Lwt.__return (op_plusquestion change tokens_per_roll))
              (fun change => loop c change)) in
    op_gtgteqquestion (Storage.Roll.Delegate_change.get c delegate)
      (fun change =>
        op_gtgteqquestion (is_inactive c delegate)
          (fun inactive =>
            op_gtgteqquestion
              (if inactive then
                __return (c, change)
              else
                op_gtgteqquestion (loop c change)
                  (fun function_parameter =>
                    let '(c, change) := function_parameter in
                    op_gtgteqquestion
                      (Storage.Roll.Delegate_roll_list.get_option c delegate)
                      (fun rolls =>
                        match rolls with
                        | None =>
                          op_gtgteq
                            (Storage.Active_delegates_with_rolls.del c delegate)
                            (fun c => __return (c, change))
                        | Some _ => __return (c, change)
                        end)))
              (fun function_parameter =>
                let '(c, change) := function_parameter in
                op_gtgteqquestion
                  (Lwt.__return (op_minusquestion change amount))
                  (fun change =>
                    Storage.Roll.Delegate_change.set c delegate change)))).
  
  Definition set_inactive
    (ctxt : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.context)
    (delegate : Tezos_raw_protocol_alpha.Storage.Roll.Delegate_change.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t) :=
    op_gtgteqquestion (ensure_inited ctxt delegate)
      (fun ctxt =>
        let tokens_per_roll := Constants_storage.tokens_per_roll ctxt in
        op_gtgteqquestion (Storage.Roll.Delegate_change.get ctxt delegate)
          (fun change =>
            op_gtgteq
              (Storage.Contract.Inactive_delegate.add ctxt
                (Contract_repr.implicit_contract delegate))
              (fun ctxt =>
                op_gtgteq
                  (Storage.Active_delegates_with_rolls.del ctxt delegate)
                  (fun ctxt =>
                    let fix loop
                      (ctxt :
                      Tezos_raw_protocol_alpha.Storage.Roll.Delegate_roll_list.context)
                      (change : Tezos_raw_protocol_alpha.Tez_repr.t)
                      : Tezos_protocol_environment_alpha__Environment.Lwt.t
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                          (Tezos_raw_protocol_alpha.Storage.Roll.Delegate_roll_list.context
                            * Tezos_raw_protocol_alpha.Tez_repr.t)) :=
                      op_gtgteqquestion
                        (Storage.Roll.Delegate_roll_list.get_option ctxt
                          delegate)
                        (fun function_parameter =>
                          match function_parameter with
                          | None => __return (ctxt, change)
                          | Some _roll =>
                            op_gtgteqquestion
                              (pop_roll_from_delegate ctxt delegate)
                              (fun function_parameter =>
                                let '(_, ctxt) := function_parameter in
                                op_gtgteqquestion
                                  (Lwt.__return
                                    (op_plusquestion change tokens_per_roll))
                                  (fun change => loop ctxt change))
                          end) in
                    op_gtgteqquestion (loop ctxt change)
                      (fun function_parameter =>
                        let '(ctxt, change) := function_parameter in
                        op_gtgteqquestion
                          (Storage.Roll.Delegate_change.set ctxt delegate change)
                          (fun ctxt => __return ctxt)))))).
  
  Definition set_active
    (ctxt : Tezos_raw_protocol_alpha.Storage.Contract.Inactive_delegate.context)
    (delegate :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t) :=
    op_gtgteqquestion (is_inactive ctxt delegate)
      (fun inactive =>
        let current_cycle := cycle (Raw_context.current_level ctxt) in
        let preserved_cycles := Constants_storage.preserved_cycles ctxt in
        op_gtgteqquestion
          (Storage.Contract.Delegate_desactivation.get_option ctxt
            (Contract_repr.implicit_contract delegate))
          (fun current_expiration =>
            let expiration :=
              match current_expiration with
              | None =>
                Cycle_repr.add current_cycle
                  (op_plus 1 (op_star 2 preserved_cycles))
              | Some current_expiration =>
                let delay :=
                  if inactive then
                    op_plus 1 (op_star 2 preserved_cycles)
                  else
                    op_plus 1 preserved_cycles in
                let updated := Cycle_repr.add current_cycle delay in
                Cycle_repr.max current_expiration updated
              end in
            op_gtgteq
              (Storage.Contract.Delegate_desactivation.init_set ctxt
                (Contract_repr.implicit_contract delegate) expiration)
              (fun ctxt =>
                if not inactive then
                  __return ctxt
                else
                  op_gtgteqquestion (ensure_inited ctxt delegate)
                    (fun ctxt =>
                      let tokens_per_roll :=
                        Constants_storage.tokens_per_roll ctxt in
                      op_gtgteqquestion
                        (Storage.Roll.Delegate_change.get ctxt delegate)
                        (fun change =>
                          op_gtgteq
                            (Storage.Contract.Inactive_delegate.del ctxt
                              (Contract_repr.implicit_contract delegate))
                            (fun ctxt =>
                              op_gtgteqquestion (delegate_pubkey ctxt delegate)
                                (fun delegate_pk =>
                                  let fix loop
                                    (ctxt :
                                    Tezos_raw_protocol_alpha.Raw_context.context)
                                    (change :
                                    Tezos_raw_protocol_alpha.Tez_repr.t)
                                    : Tezos_protocol_environment_alpha__Environment.Lwt.t
                                      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                                        Tezos_raw_protocol_alpha.Raw_context.context) :=
                                    if op_lt change tokens_per_roll then
                                      __return ctxt
                                    else
                                      op_gtgteqquestion
                                        (Lwt.__return
                                          (op_minusquestion change
                                            tokens_per_roll))
                                        (fun change =>
                                          op_gtgteqquestion
                                            (create_roll_in_delegate ctxt
                                              delegate delegate_pk)
                                            (fun ctxt => loop ctxt change)) in
                                  op_gtgteqquestion (loop ctxt change)
                                    (fun ctxt =>
                                      op_gtgteqquestion
                                        (Storage.Roll.Delegate_roll_list.get_option
                                          ctxt delegate)
                                        (fun rolls =>
                                          match rolls with
                                          | None => __return ctxt
                                          | Some _ =>
                                            op_gtgteq
                                              (Storage.Active_delegates_with_rolls.add
                                                ctxt delegate)
                                              (fun ctxt => __return ctxt)
                                          end))))))))).
End Delegate.

Module Contract.
  Definition add_amount
    (c : Tezos_raw_protocol_alpha.Storage.Contract.Delegate.context)
    (contract : Tezos_raw_protocol_alpha.Storage.Contract.Delegate.key)
    (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Storage.Contract.Delegate.context) :=
    op_gtgteqquestion (get_contract_delegate c contract)
      (fun function_parameter =>
        match function_parameter with
        | None => __return c
        | Some delegate => Delegate.add_amount c delegate amount
        end).
  
  Definition remove_amount
    (c : Tezos_raw_protocol_alpha.Storage.Contract.Delegate.context)
    (contract : Tezos_raw_protocol_alpha.Storage.Contract.Delegate.key)
    (amount : Tezos_raw_protocol_alpha.Tez_repr.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Storage.Contract.Delegate.context) :=
    op_gtgteqquestion (get_contract_delegate c contract)
      (fun function_parameter =>
        match function_parameter with
        | None => __return c
        | Some delegate => Delegate.remove_amount c delegate amount
        end).
End Contract.

Definition init (ctxt : Tezos_raw_protocol_alpha.Storage.Roll.Next.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  Storage.Roll.Next.init ctxt Roll_repr.first.

Definition init_first_cycles
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let preserved := Constants_storage.preserved_cycles ctxt in
  op_gtgteqquestion
    (List.fold_left
      (fun ctxt =>
        fun c =>
          op_gtgteqquestion ctxt
            (fun ctxt =>
              let cycle := Cycle_repr.of_int32_exn (Int32.of_int c) in
              op_gtgteqquestion
                (Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0)
                (fun ctxt =>
                  op_gtgteqquestion (snapshot_rolls_for_cycle ctxt cycle)
                    (fun ctxt => freeze_rolls_for_cycle ctxt cycle))))
      (__return ctxt) (op_minusminusgt 0 preserved))
    (fun ctxt =>
      let cycle := Cycle_repr.of_int32_exn (Int32.of_int (op_plus preserved 1))
        in
      op_gtgteqquestion (Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0)
        (fun ctxt =>
          op_gtgteqquestion (snapshot_rolls_for_cycle ctxt cycle)
            (fun ctxt =>
              let cycle :=
                Cycle_repr.of_int32_exn (Int32.of_int (op_plus preserved 2)) in
              op_gtgteqquestion
                (Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0)
                (fun ctxt => __return ctxt)))).

Definition snapshot_rolls (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let current_level := Raw_context.current_level ctxt in
  let preserved := Constants_storage.preserved_cycles ctxt in
  let cycle := Cycle_repr.add (cycle current_level) (op_plus preserved 2) in
  snapshot_rolls_for_cycle ctxt cycle.

Definition cycle_end
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (last_cycle : Tezos_raw_protocol_alpha.Cycle_repr.cycle)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let preserved := Constants_storage.preserved_cycles ctxt in
  op_gtgteqquestion
    match Cycle_repr.sub last_cycle preserved with
    | None => __return ctxt
    | Some cleared_cycle => clear_cycle ctxt cleared_cycle
    end
    (fun ctxt =>
      let frozen_roll_cycle := Cycle_repr.add last_cycle (op_plus preserved 1)
        in
      op_gtgteqquestion (freeze_rolls_for_cycle ctxt frozen_roll_cycle)
        (fun ctxt =>
          op_gtgteqquestion
            (Storage.Roll.Snapshot_for_cycle.init ctxt
              (Cycle_repr.succ (Cycle_repr.succ frozen_roll_cycle)) 0)
            (fun ctxt => __return ctxt))).

Definition update_tokens_per_roll
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (new_tokens_per_roll : Tezos_raw_protocol_alpha.Tez_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.context) :=
  let constants := Raw_context.constants ctxt in
  let old_tokens_per_roll := tokens_per_roll constants in
  op_gtgteq
    (Raw_context.patch_constants ctxt
      (fun constants =>
        (* ❌ Record substitution not handled *)
        record_substitution))
    (fun ctxt =>
      let decrease := op_lt new_tokens_per_roll old_tokens_per_roll in
      op_gtgteqquestion
        (if decrease then
          Lwt.__return
            (op_minusquestion old_tokens_per_roll new_tokens_per_roll)
        else
          Lwt.__return
            (op_minusquestion new_tokens_per_roll old_tokens_per_roll))
        (fun abs_diff =>
          Storage.Delegates.fold ctxt
            (Tezos_protocol_environment_alpha__Environment.Pervasives.Ok ctxt)
            (fun pkh =>
              fun ctxt =>
                op_gtgteqquestion (Lwt.__return ctxt)
                  (fun ctxt =>
                    op_gtgteqquestion (count_rolls ctxt pkh)
                      (fun rolls =>
                        op_gtgteqquestion
                          (Lwt.__return
                            (op_starquestion abs_diff (Int64.of_int rolls)))
                          (fun amount =>
                            if decrease then
                              Delegate.add_amount ctxt pkh amount
                            else
                              Delegate.remove_amount ctxt pkh amount)))))).
roll_storage.mli 2 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(**

   Basic roll manipulation.

   If storage related to roll (a.k.a. `Storage.Roll`) are not used
   outside of this module, this interface enforces the invariant that a
   roll is always either in the limbo list or in a contract list.

*)

type error +=
  | Consume_roll_change
  | No_roll_for_delegate
  | No_roll_snapshot_for_cycle of Cycle_repr.t
  | Unregistered_delegate of Signature.Public_key_hash.t

(* `Permanent *)

val init : Raw_context.t -> Raw_context.t tzresult Lwt.t

val init_first_cycles : Raw_context.t -> Raw_context.t tzresult Lwt.t

val cycle_end : Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t

val snapshot_rolls : Raw_context.t -> Raw_context.t tzresult Lwt.t

val fold :
  Raw_context.t ->
  f:(Roll_repr.roll -> Signature.Public_key.t -> 'a -> 'a tzresult Lwt.t) ->
  'a ->
  'a tzresult Lwt.t

val baking_rights_owner :
  Raw_context.t ->
  Level_repr.t ->
  priority:int ->
  Signature.Public_key.t tzresult Lwt.t

val endorsement_rights_owner :
  Raw_context.t ->
  Level_repr.t ->
  slot:int ->
  Signature.Public_key.t tzresult Lwt.t

module Delegate : sig
  val is_inactive :
    Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t

  val add_amount :
    Raw_context.t ->
    Signature.Public_key_hash.t ->
    Tez_repr.t ->
    Raw_context.t tzresult Lwt.t

  val remove_amount :
    Raw_context.t ->
    Signature.Public_key_hash.t ->
    Tez_repr.t ->
    Raw_context.t tzresult Lwt.t

  val set_inactive :
    Raw_context.t ->
    Signature.Public_key_hash.t ->
    Raw_context.t tzresult Lwt.t

  val set_active :
    Raw_context.t ->
    Signature.Public_key_hash.t ->
    Raw_context.t tzresult Lwt.t
end

module Contract : sig
  val add_amount :
    Raw_context.t ->
    Contract_repr.t ->
    Tez_repr.t ->
    Raw_context.t tzresult Lwt.t

  val remove_amount :
    Raw_context.t ->
    Contract_repr.t ->
    Tez_repr.t ->
    Raw_context.t tzresult Lwt.t
end

val delegate_pubkey :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Signature.Public_key.t tzresult Lwt.t

val get_rolls :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Roll_repr.t list tzresult Lwt.t

val get_change :
  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t

val update_tokens_per_roll :
  Raw_context.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t

(**/**)

val get_contract_delegate :
  Raw_context.t ->
  Contract_repr.t ->
  Signature.Public_key_hash.t option tzresult Lwt.t
roll_storage_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

extensible_type

Parameter init :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter init_first_cycles :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter cycle_end :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).

Parameter snapshot_rolls :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter fold : forall {a : Type},
Tezos_raw_protocol_alpha.Raw_context.t ->
  (Tezos_raw_protocol_alpha.Roll_repr.roll ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t ->
      a ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult a))
    ->
    a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult a).

Parameter baking_rights_owner :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Level_repr.t ->
    Z ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t).

Parameter endorsement_rights_owner :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Level_repr.t ->
    Z ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t).

Module Delegate.
  Parameter is_inactive : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult bool).
  
  Parameter add_amount : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_raw_protocol_alpha.Tez_repr.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Raw_context.t).
  
  Parameter remove_amount : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_raw_protocol_alpha.Tez_repr.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Raw_context.t).
  
  Parameter set_inactive : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
  
  Parameter set_active : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
End Delegate.

Module Contract.
  Parameter add_amount : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_raw_protocol_alpha.Contract_repr.t ->
      Tezos_raw_protocol_alpha.Tez_repr.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Raw_context.t).
  
  Parameter remove_amount : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_raw_protocol_alpha.Contract_repr.t ->
      Tezos_raw_protocol_alpha.Tez_repr.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Raw_context.t).
End Contract.

Parameter delegate_pubkey :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key.t).

Parameter get_rolls :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (list Tezos_raw_protocol_alpha.Roll_repr.t)).

Parameter get_change :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Tez_repr.t).

Parameter update_tokens_per_roll :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Tez_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).

Parameter get_contract_delegate :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Contract_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (option
          Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)).
script_expr_hash.ml 3 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

let script_expr_hash = "\013\044\064\027" (* expr(54) *)

include Blake2B.Make
          (Base58)
          (struct
            let name = "script_expr"

            let title = "A script expression ID"

            let b58check_prefix = script_expr_hash

            let size = None
          end)

let () = Base58.check_encoded_prefix b58check_encoding "expr" 54
script_expr_hash_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition script_expr_hash : string := "
,@" % string.

(* ❌ Cannot include this kind of module expression *)
include

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute Base58.check_encoded_prefix b58check_encoding "expr" % string 54.
script_int_repr.ml 10 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type n = Natural_tag

type z = Integer_tag

type 't num = Z.t

let compare x y = Z.compare x y

let zero = Z.zero

let zero_n = Z.zero

let to_string x = Z.to_string x

let of_string s = try Some (Z.of_string s) with _ -> None

let to_int64 x = try Some (Z.to_int64 x) with _ -> None

let of_int64 n = Z.of_int64 n

let to_int x = try Some (Z.to_int x) with _ -> None

let of_int n = Z.of_int n

let of_zint x = x

let to_zint x = x

let add x y = Z.add x y

let sub x y = Z.sub x y

let mul x y = Z.mul x y

let ediv x y =
  try
    let (q, r) = Z.ediv_rem x y in
    Some (q, r)
  with _ -> None

let add_n = add

let mul_n = mul

let ediv_n = ediv

let abs x = Z.abs x

let is_nat x = if Compare.Z.(x < Z.zero) then None else Some x

let neg x = Z.neg x

let int x = x

let shift_left x y =
  if Compare.Int.(Z.compare y (Z.of_int 256) > 0) then None
  else
    let y = Z.to_int y in
    Some (Z.shift_left x y)

let shift_right x y =
  if Compare.Int.(Z.compare y (Z.of_int 256) > 0) then None
  else
    let y = Z.to_int y in
    Some (Z.shift_right x y)

let shift_left_n = shift_left

let shift_right_n = shift_right

let logor x y = Z.logor x y

let logxor x y = Z.logxor x y

let logand x y = Z.logand x y

let lognot x = Z.lognot x
script_int_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive n : Type :=
| Natural_tag : n.

Inductive z : Type :=
| Integer_tag : z.

Definition num (t : Type) := Tezos_protocol_environment_alpha__Environment.Z.t.

Definition compare
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t) : Z := Z.compare x y.

Definition zero : Tezos_protocol_environment_alpha__Environment.Z.t := Z.zero.

Definition zero_n : Tezos_protocol_environment_alpha__Environment.Z.t := Z.zero.

Definition to_string (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  : string := Z.to_string x.

Definition of_string (s : string)
  : option Tezos_protocol_environment_alpha__Environment.Z.t :=
  (* ❌ Try-with are not handled *)
  try (Some (Z.of_string s)).

Definition to_int64 (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  : option int64 :=
  (* ❌ Try-with are not handled *)
  try (Some (Z.to_int64 x)).

Definition of_int64 (n : int64)
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.of_int64 n.

Definition to_int (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  : option Z :=
  (* ❌ Try-with are not handled *)
  try (Some (Z.to_int x)).

Definition of_int (n : Z) : Tezos_protocol_environment_alpha__Environment.Z.t :=
  Z.of_int n.

Definition of_zint {A : Type} (x : A) : A := x.

Definition to_zint {A : Type} (x : A) : A := x.

Definition add
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.add x y.

Definition sub
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.sub x y.

Definition mul
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.mul x y.

Definition ediv
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t)
  : option
    (Tezos_protocol_environment_alpha__Environment.Z.t *
      Tezos_protocol_environment_alpha__Environment.Z.t) :=
  (* ❌ Try-with are not handled *)
  try
    (let '(q, r) := Z.ediv_rem x y in
    Some (q, r)).

Definition add_n
  : Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_protocol_environment_alpha__Environment.Z.t := add.

Definition mul_n
  : Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_protocol_environment_alpha__Environment.Z.t := mul.

Definition ediv_n
  : Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Z.t ->
      option
        (Tezos_protocol_environment_alpha__Environment.Z.t *
          Tezos_protocol_environment_alpha__Environment.Z.t) := ediv.

Definition abs (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.abs x.

Definition is_nat
  (x :
    Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : option
    Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.t) :=
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
      x Z.zero then
    None
  else
    Some x.

Definition neg (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.neg x.

Definition int {A : Type} (x : A) : A := x.

Definition shift_left
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t)
  : option Tezos_protocol_environment_alpha__Environment.Z.t :=
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
      (Z.compare y (Z.of_int 256)) 0 then
    None
  else
    let y := Z.to_int y in
    Some (Z.shift_left x y).

Definition shift_right
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t)
  : option Tezos_protocol_environment_alpha__Environment.Z.t :=
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
      (Z.compare y (Z.of_int 256)) 0 then
    None
  else
    let y := Z.to_int y in
    Some (Z.shift_right x y).

Definition shift_left_n
  : Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Z.t ->
      option Tezos_protocol_environment_alpha__Environment.Z.t := shift_left.

Definition shift_right_n
  : Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Z.t ->
      option Tezos_protocol_environment_alpha__Environment.Z.t := shift_right.

Definition logor
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.logor x y.

Definition logxor
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.logxor x y.

Definition logand
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.logand x y.

Definition lognot (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_protocol_environment_alpha__Environment.Z.t := Z.lognot x.
script_int_repr.mli 16 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** The types for arbitraty precision integers in Michelson.
    The type variable ['t] is always [n] or [z],
    [n num] and [z num] are incompatible.

    This is internally a [Z.t].
    This module mostly adds signedness preservation guarantees. *)
type 't num

(** Flag for natural numbers. *)
and n = Natural_tag

(** Flag for relative numbers. *)
and z = Integer_tag

(** Natural zero. *)
val zero_n : n num

(** Relative zero. *)
val zero : z num

(** Compare two numbers as if they were *)
val compare : 'a num -> 'a num -> int

(** Conversion to an OCaml [string] in decimal notation. *)
val to_string : _ num -> string

(** Conversion from an OCaml [string].
    Returns [None] in case of an invalid notation.
    Supports [+] and [-] sign modifiers, and [0x], [0o] and [0b] base modifiers. *)
val of_string : string -> z num option

(** Conversion to an OCaml [int64], returns [None] on overflow. *)
val to_int64 : _ num -> int64 option

(** Conversion from an OCaml [int]. *)
val of_int64 : int64 -> z num

(** Conversion to an OCaml [int], returns [None] on overflow. *)
val to_int : _ num -> int option

(** Conversion from an OCaml [int64]. *)
val of_int : int -> z num

(** Conversion from a Zarith integer ([Z.t]). *)
val of_zint : Z.t -> z num

(** Conversion to a Zarith integer ([Z.t]). *)
val to_zint : 'a num -> Z.t

(** Addition between naturals. *)
val add_n : n num -> n num -> n num

(** Multiplication between naturals. *)
val mul_n : n num -> n num -> n num

(** Euclidean division between naturals.
    [ediv_n n d] returns [None] if divisor is zero,
    or [Some (q, r)] where [n = d * q + r] and [[0 <= r < d]] otherwise. *)
val ediv_n : n num -> n num -> (n num * n num) option

(** Sign agnostic addition.
    Use {!add_n} when working with naturals to preserve the sign. *)
val add : _ num -> _ num -> z num

(** Sign agnostic subtraction.
    Use {!sub_n} when working with naturals to preserve the sign. *)
val sub : _ num -> _ num -> z num

(** Sign agnostic multiplication.
    Use {!mul_n} when working with naturals to preserve the sign. *)
val mul : _ num -> _ num -> z num

(** Sign agnostic euclidean division.
    [ediv n d] returns [None] if divisor is zero,
    or [Some (q, r)] where [n = d * q + r] and [[0 <= r < |d|]] otherwise.
    Use {!ediv_n} when working with naturals to preserve the sign. *)
val ediv : _ num -> _ num -> (z num * n num) option

(** Compute the absolute value of a relative, turning it into a natural. *)
val abs : z num -> n num

(** Partial identity over [N]. *)
val is_nat : z num -> n num option

(** Negates a number. *)
val neg : _ num -> z num

(** Turns a natural into a relative, not changing its value. *)
val int : n num -> z num

(** Reverses each bit in the representation of the number.
    Also applies to the sign. *)
val lognot : _ num -> z num

(** Shifts the natural to the left of a number of bits between 0 and 256.
    Returns [None] if the amount is too high. *)
val shift_left_n : n num -> n num -> n num option

(** Shifts the natural to the right of a number of bits between 0 and 256.
    Returns [None] if the amount is too high. *)
val shift_right_n : n num -> n num -> n num option

(** Shifts the number to the left of a number of bits between 0 and 256.
    Returns [None] if the amount is too high. *)
val shift_left : 'a num -> n num -> 'a num option

(** Shifts the number to the right of a number of bits between 0 and 256.
    Returns [None] if the amount is too high. *)
val shift_right : 'a num -> n num -> 'a num option

(** Applies a boolean or operation to each bit. *)
val logor : 'a num -> 'a num -> 'a num

(** Applies a boolean and operation to each bit. *)
val logand : _ num -> n num -> n num

(** Applies a boolean xor operation to each bit. *)
val logxor : n num -> n num -> n num
script_int_repr_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive n : Type :=
| Natural_tag : n

with z : Type :=
| Integer_tag : z.

Parameter zero_n : num n.

Parameter zero : num z.

Parameter compare : forall {a : Type}, num a -> num a -> Z.

Parameter to_string : forall {_ : Type}, num _ -> string.

Parameter of_string : string -> option (num z).

Parameter to_int64 : forall {_ : Type}, num _ -> option int64.

Parameter of_int64 : int64 -> num z.

Parameter to_int : forall {_ : Type}, num _ -> option Z.

Parameter of_int : Z -> num z.

Parameter of_zint : Tezos_protocol_environment_alpha__Environment.Z.t -> num z.

Parameter to_zint : forall {a : Type},
num a -> Tezos_protocol_environment_alpha__Environment.Z.t.

Parameter add_n : num n -> num n -> num n.

Parameter mul_n : num n -> num n -> num n.

Parameter ediv_n : num n -> num n -> option (num n * num n).

Parameter add : forall {_ : Type}, num _ -> num _ -> num z.

Parameter sub : forall {_ : Type}, num _ -> num _ -> num z.

Parameter mul : forall {_ : Type}, num _ -> num _ -> num z.

Parameter ediv : forall {_ : Type}, num _ -> num _ -> option (num z * num n).

Parameter abs : num z -> num n.

Parameter is_nat : num z -> option (num n).

Parameter neg : forall {_ : Type}, num _ -> num z.

Parameter int : num n -> num z.

Parameter lognot : forall {_ : Type}, num _ -> num z.

Parameter shift_left_n : num n -> num n -> option (num n).

Parameter shift_right_n : num n -> num n -> option (num n).

Parameter shift_left : forall {a : Type}, num a -> num n -> option (num a).

Parameter shift_right : forall {a : Type}, num a -> num n -> option (num a).

Parameter logor : forall {a : Type}, num a -> num a -> num a.

Parameter logand : forall {_ : Type}, num _ -> num n -> num n.

Parameter logxor : num n -> num n -> num n.
script_interpreter.ml 46 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Script
open Script_typed_ir
open Script_ir_translator

(* ---- Run-time errors -----------------------------------------------------*)

type execution_trace =
  (Script.location * Gas.t * (Script.expr * string option) list) list

type error +=
  | Reject of Script.location * Script.expr * execution_trace option

type error += Overflow of Script.location * execution_trace option

type error += Runtime_contract_error : Contract.t * Script.expr -> error

type error += Bad_contract_parameter of Contract.t (* `Permanent *)

type error += Cannot_serialize_log

type error += Cannot_serialize_failure

type error += Cannot_serialize_storage

let () =
  let open Data_encoding in
  let trace_encoding =
    list
    @@ obj3
         (req "location" Script.location_encoding)
         (req "gas" Gas.encoding)
         (req
            "stack"
            (list (obj2 (req "item" Script.expr_encoding) (opt "annot" string))))
  in
  (* Reject *)
  register_error_kind
    `Temporary
    ~id:"michelson_v1.script_rejected"
    ~title:"Script failed"
    ~description:"A FAILWITH instruction was reached"
    (obj3
       (req "location" Script.location_encoding)
       (req "with" Script.expr_encoding)
       (opt "trace" trace_encoding))
    (function Reject (loc, v, trace) -> Some (loc, v, trace) | _ -> None)
    (fun (loc, v, trace) -> Reject (loc, v, trace)) ;
  (* Overflow *)
  register_error_kind
    `Temporary
    ~id:"michelson_v1.script_overflow"
    ~title:"Script failed (overflow error)"
    ~description:
      "A FAIL instruction was reached due to the detection of an overflow"
    (obj2
       (req "location" Script.location_encoding)
       (opt "trace" trace_encoding))
    (function Overflow (loc, trace) -> Some (loc, trace) | _ -> None)
    (fun (loc, trace) -> Overflow (loc, trace)) ;
  (* Runtime contract error *)
  register_error_kind
    `Temporary
    ~id:"michelson_v1.runtime_error"
    ~title:"Script runtime error"
    ~description:"Toplevel error for all runtime script errors"
    (obj2
       (req "contract_handle" Contract.encoding)
       (req "contract_code" Script.expr_encoding))
    (function
      | Runtime_contract_error (contract, expr) ->
          Some (contract, expr)
      | _ ->
          None)
    (fun (contract, expr) -> Runtime_contract_error (contract, expr)) ;
  (* Bad contract parameter *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.bad_contract_parameter"
    ~title:"Contract supplied an invalid parameter"
    ~description:
      "Either no parameter was supplied to a contract with a non-unit \
       parameter type, a non-unit parameter was passed to an account, or a \
       parameter was supplied of the wrong type"
    Data_encoding.(obj1 (req "contract" Contract.encoding))
    (function Bad_contract_parameter c -> Some c | _ -> None)
    (fun c -> Bad_contract_parameter c) ;
  (* Cannot serialize log *)
  register_error_kind
    `Temporary
    ~id:"michelson_v1.cannot_serialize_log"
    ~title:"Not enough gas to serialize execution trace"
    ~description:
      "Execution trace with stacks was to big to be serialized with the \
       provided gas"
    Data_encoding.empty
    (function Cannot_serialize_log -> Some () | _ -> None)
    (fun () -> Cannot_serialize_log) ;
  (* Cannot serialize failure *)
  register_error_kind
    `Temporary
    ~id:"michelson_v1.cannot_serialize_failure"
    ~title:"Not enough gas to serialize argument of FAILWITH"
    ~description:
      "Argument of FAILWITH was too big to be serialized with the provided gas"
    Data_encoding.empty
    (function Cannot_serialize_failure -> Some () | _ -> None)
    (fun () -> Cannot_serialize_failure) ;
  (* Cannot serialize storage *)
  register_error_kind
    `Temporary
    ~id:"michelson_v1.cannot_serialize_storage"
    ~title:"Not enough gas to serialize execution storage"
    ~description:
      "The returned storage was too big to be serialized with the provided gas"
    Data_encoding.empty
    (function Cannot_serialize_storage -> Some () | _ -> None)
    (fun () -> Cannot_serialize_storage)

(* ---- interpreter ---------------------------------------------------------*)

type 'tys stack =
  | Item : 'ty * 'rest stack -> ('ty * 'rest) stack
  | Empty : end_of_stack stack

let unparse_stack ctxt (stack, stack_ty) =
  (* We drop the gas limit as this function is only used for debugging/errors. *)
  let ctxt = Gas.set_unlimited ctxt in
  let rec unparse_stack :
      type a.
      a stack * a stack_ty -> (Script.expr * string option) list tzresult Lwt.t
      = function
    | (Empty, Empty_t) ->
        return_nil
    | (Item (v, rest), Item_t (ty, rest_ty, annot)) ->
        unparse_data ctxt Readable ty v
        >>=? fun (data, _ctxt) ->
        unparse_stack (rest, rest_ty)
        >>=? fun rest ->
        let annot =
          match Script_ir_annot.unparse_var_annot annot with
          | [] ->
              None
          | [a] ->
              Some a
          | _ ->
              assert false
        in
        let data = Micheline.strip_locations data in
        return ((data, annot) :: rest)
  in
  unparse_stack (stack, stack_ty)

module Interp_costs = Michelson_v1_gas.Cost_of.Interpreter

let rec interp_stack_prefix_preserving_operation :
    type fbef bef faft aft result.
    (fbef stack -> (faft stack * result) tzresult Lwt.t) ->
    (fbef, faft, bef, aft) stack_prefix_preservation_witness ->
    bef stack ->
    (aft stack * result) tzresult Lwt.t =
 fun f n stk ->
  match (n, stk) with
  | ( Prefix
        (Prefix
          (Prefix
            (Prefix
              (Prefix
                (Prefix
                  (Prefix
                    (Prefix
                      (Prefix
                        (Prefix
                          (Prefix
                            (Prefix (Prefix (Prefix (Prefix (Prefix n))))))))))))))),
      Item
        ( v0,
          Item
            ( v1,
              Item
                ( v2,
                  Item
                    ( v3,
                      Item
                        ( v4,
                          Item
                            ( v5,
                              Item
                                ( v6,
                                  Item
                                    ( v7,
                                      Item
                                        ( v8,
                                          Item
                                            ( v9,
                                              Item
                                                ( va,
                                                  Item
                                                    ( vb,
                                                      Item
                                                        ( vc,
                                                          Item
                                                            ( vd,
                                                              Item
                                                                ( ve,
                                                                  Item
                                                                    (vf, rest)
                                                                ) ) ) ) ) ) )
                                    ) ) ) ) ) ) ) ) ) ->
      interp_stack_prefix_preserving_operation f n rest
      >>=? fun (rest', result) ->
      return
        ( Item
            ( v0,
              Item
                ( v1,
                  Item
                    ( v2,
                      Item
                        ( v3,
                          Item
                            ( v4,
                              Item
                                ( v5,
                                  Item
                                    ( v6,
                                      Item
                                        ( v7,
                                          Item
                                            ( v8,
                                              Item
                                                ( v9,
                                                  Item
                                                    ( va,
                                                      Item
                                                        ( vb,
                                                          Item
                                                            ( vc,
                                                              Item
                                                                ( vd,
                                                                  Item
                                                                    ( ve,
                                                                      Item
                                                                        ( vf,
                                                                          rest'
                                                                        ) ) )
                                                            ) ) ) ) ) ) ) ) )
                        ) ) ) ),
          result )
  | ( Prefix (Prefix (Prefix (Prefix n))),
      Item (v0, Item (v1, Item (v2, Item (v3, rest)))) ) ->
      interp_stack_prefix_preserving_operation f n rest
      >>=? fun (rest', result) ->
      return (Item (v0, Item (v1, Item (v2, Item (v3, rest')))), result)
  | (Prefix n, Item (v, rest)) ->
      interp_stack_prefix_preserving_operation f n rest
      >>=? fun (rest', result) -> return (Item (v, rest'), result)
  | (Rest, v) ->
      f v

type step_constants = {
  source : Contract.t;
  payer : Contract.t;
  self : Contract.t;
  amount : Tez.t;
  chain_id : Chain_id.t;
}

let rec step :
    type b a.
    ?log:execution_trace ref ->
    context ->
    step_constants ->
    (b, a) descr ->
    b stack ->
    (a stack * context) tzresult Lwt.t =
 fun ?log ctxt step_constants ({instr; loc; _} as descr) stack ->
  Lwt.return (Gas.consume ctxt Interp_costs.cycle)
  >>=? fun ctxt ->
  let logged_return :
      type a b.
      (b, a) descr -> a stack * context -> (a stack * context) tzresult Lwt.t =
   fun descr (ret, ctxt) ->
    match log with
    | None ->
        return (ret, ctxt)
    | Some log ->
        trace Cannot_serialize_log (unparse_stack ctxt (ret, descr.aft))
        >>=? fun stack ->
        log := (descr.loc, Gas.level ctxt, stack) :: !log ;
        return (ret, ctxt)
  in
  let get_log (log : execution_trace ref option) =
    Option.map ~f:(fun l -> List.rev !l) log
  in
  let consume_gas_terop :
      type ret arg1 arg2 arg3 rest.
      (_ * (_ * (_ * rest)), ret * rest) descr ->
      (arg1 -> arg2 -> arg3 -> ret) * arg1 * arg2 * arg3 ->
      (arg1 -> arg2 -> arg3 -> Gas.cost) ->
      rest stack ->
      ((ret * rest) stack * context) tzresult Lwt.t =
   fun descr (op, x1, x2, x3) cost_func rest ->
    Lwt.return (Gas.consume ctxt (cost_func x1 x2 x3))
    >>=? fun ctxt -> logged_return descr (Item (op x1 x2 x3, rest), ctxt)
  in
  let consume_gas_binop :
      type ret arg1 arg2 rest.
      (_ * (_ * rest), ret * rest) descr ->
      (arg1 -> arg2 -> ret) * arg1 * arg2 ->
      (arg1 -> arg2 -> Gas.cost) ->
      rest stack ->
      context ->
      ((ret * rest) stack * context) tzresult Lwt.t =
   fun descr (op, x1, x2) cost_func rest ctxt ->
    Lwt.return (Gas.consume ctxt (cost_func x1 x2))
    >>=? fun ctxt -> logged_return descr (Item (op x1 x2, rest), ctxt)
  in
  let consume_gas_unop :
      type ret arg rest.
      (_ * rest, ret * rest) descr ->
      (arg -> ret) * arg ->
      (arg -> Gas.cost) ->
      rest stack ->
      context ->
      ((ret * rest) stack * context) tzresult Lwt.t =
   fun descr (op, arg) cost_func rest ctxt ->
    Lwt.return (Gas.consume ctxt (cost_func arg))
    >>=? fun ctxt -> logged_return descr (Item (op arg, rest), ctxt)
  in
  let logged_return : a stack * context -> (a stack * context) tzresult Lwt.t =
    logged_return descr
  in
  match (instr, stack) with
  (* stack ops *)
  | (Drop, Item (_, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.stack_op)
      >>=? fun ctxt -> logged_return (rest, ctxt)
  | (Dup, Item (v, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.stack_op)
      >>=? fun ctxt -> logged_return (Item (v, Item (v, rest)), ctxt)
  | (Swap, Item (vi, Item (vo, rest))) ->
      Lwt.return (Gas.consume ctxt Interp_costs.stack_op)
      >>=? fun ctxt -> logged_return (Item (vo, Item (vi, rest)), ctxt)
  | (Const v, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.push)
      >>=? fun ctxt -> logged_return (Item (v, rest), ctxt)
  (* options *)
  | (Cons_some, Item (v, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.wrap)
      >>=? fun ctxt -> logged_return (Item (Some v, rest), ctxt)
  | (Cons_none _, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.variant_no_data)
      >>=? fun ctxt -> logged_return (Item (None, rest), ctxt)
  | (If_none (bt, _), Item (None, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.branch)
      >>=? fun ctxt -> step ?log ctxt step_constants bt rest
  | (If_none (_, bf), Item (Some v, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.branch)
      >>=? fun ctxt -> step ?log ctxt step_constants bf (Item (v, rest))
  (* pairs *)
  | (Cons_pair, Item (a, Item (b, rest))) ->
      Lwt.return (Gas.consume ctxt Interp_costs.pair)
      >>=? fun ctxt -> logged_return (Item ((a, b), rest), ctxt)
  (* Peephole optimization for UNPAIR *)
  | ( Seq
        ( {instr = Dup; _},
          { instr =
              Seq
                ( {instr = Car; _},
                  { instr = Seq ({instr = Dip {instr = Cdr}}, {instr = Nop; _});
                    _ } );
            _ } ),
      Item ((a, b), rest) ) ->
      Lwt.return (Gas.consume ctxt Interp_costs.pair_access)
      >>=? fun ctxt -> logged_return (Item (a, Item (b, rest)), ctxt)
  | (Car, Item ((a, _), rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.pair_access)
      >>=? fun ctxt -> logged_return (Item (a, rest), ctxt)
  | (Cdr, Item ((_, b), rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.pair_access)
      >>=? fun ctxt -> logged_return (Item (b, rest), ctxt)
  (* unions *)
  | (Left, Item (v, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.wrap)
      >>=? fun ctxt -> logged_return (Item (L v, rest), ctxt)
  | (Right, Item (v, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.wrap)
      >>=? fun ctxt -> logged_return (Item (R v, rest), ctxt)
  | (If_left (bt, _), Item (L v, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.branch)
      >>=? fun ctxt -> step ?log ctxt step_constants bt (Item (v, rest))
  | (If_left (_, bf), Item (R v, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.branch)
      >>=? fun ctxt -> step ?log ctxt step_constants bf (Item (v, rest))
  (* lists *)
  | (Cons_list, Item (hd, Item (tl, rest))) ->
      Lwt.return (Gas.consume ctxt Interp_costs.cons)
      >>=? fun ctxt -> logged_return (Item (hd :: tl, rest), ctxt)
  | (Nil, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.variant_no_data)
      >>=? fun ctxt -> logged_return (Item ([], rest), ctxt)
  | (If_cons (_, bf), Item ([], rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.branch)
      >>=? fun ctxt -> step ?log ctxt step_constants bf rest
  | (If_cons (bt, _), Item (hd :: tl, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.branch)
      >>=? fun ctxt ->
      step ?log ctxt step_constants bt (Item (hd, Item (tl, rest)))
  | (List_map body, Item (l, rest)) ->
      let rec loop rest ctxt l acc =
        Lwt.return (Gas.consume ctxt Interp_costs.loop_map)
        >>=? fun ctxt ->
        match l with
        | [] ->
            return (Item (List.rev acc, rest), ctxt)
        | hd :: tl ->
            step ?log ctxt step_constants body (Item (hd, rest))
            >>=? fun (Item (hd, rest), ctxt) -> loop rest ctxt tl (hd :: acc)
      in
      loop rest ctxt l [] >>=? fun (res, ctxt) -> logged_return (res, ctxt)
  | (List_size, Item (list, rest)) ->
      Lwt.return
        (List.fold_left
           (fun acc _ ->
             acc
             >>? fun (size, ctxt) ->
             Gas.consume ctxt Interp_costs.loop_size
             >>? fun ctxt -> ok (size + 1 (* FIXME: overflow *), ctxt))
           (ok (0, ctxt))
           list)
      >>=? fun (len, ctxt) ->
      logged_return (Item (Script_int.(abs (of_int len)), rest), ctxt)
  | (List_iter body, Item (l, init)) ->
      let rec loop ctxt l stack =
        Lwt.return (Gas.consume ctxt Interp_costs.loop_iter)
        >>=? fun ctxt ->
        match l with
        | [] ->
            return (stack, ctxt)
        | hd :: tl ->
            step ?log ctxt step_constants body (Item (hd, stack))
            >>=? fun (stack, ctxt) -> loop ctxt tl stack
      in
      loop ctxt l init >>=? fun (res, ctxt) -> logged_return (res, ctxt)
  (* sets *)
  | (Empty_set t, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.empty_set)
      >>=? fun ctxt -> logged_return (Item (empty_set t, rest), ctxt)
  | (Set_iter body, Item (set, init)) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.set_to_list set))
      >>=? fun ctxt ->
      let l = List.rev (set_fold (fun e acc -> e :: acc) set []) in
      let rec loop ctxt l stack =
        Lwt.return (Gas.consume ctxt Interp_costs.loop_iter)
        >>=? fun ctxt ->
        match l with
        | [] ->
            return (stack, ctxt)
        | hd :: tl ->
            step ?log ctxt step_constants body (Item (hd, stack))
            >>=? fun (stack, ctxt) -> loop ctxt tl stack
      in
      loop ctxt l init >>=? fun (res, ctxt) -> logged_return (res, ctxt)
  | (Set_mem, Item (v, Item (set, rest))) ->
      consume_gas_binop descr (set_mem, v, set) Interp_costs.set_mem rest ctxt
  | (Set_update, Item (v, Item (presence, Item (set, rest)))) ->
      consume_gas_terop
        descr
        (set_update, v, presence, set)
        Interp_costs.set_update
        rest
  | (Set_size, Item (set, rest)) ->
      consume_gas_unop
        descr
        (set_size, set)
        (fun _ -> Interp_costs.set_size)
        rest
        ctxt
  (* maps *)
  | (Empty_map (t, _), rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.empty_map)
      >>=? fun ctxt -> logged_return (Item (empty_map t, rest), ctxt)
  | (Map_map body, Item (map, rest)) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.map_to_list map))
      >>=? fun ctxt ->
      let l = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in
      let rec loop rest ctxt l acc =
        Lwt.return (Gas.consume ctxt Interp_costs.loop_map)
        >>=? fun ctxt ->
        match l with
        | [] ->
            return (acc, ctxt)
        | ((k, _) as hd) :: tl ->
            step ?log ctxt step_constants body (Item (hd, rest))
            >>=? fun (Item (hd, rest), ctxt) ->
            loop rest ctxt tl (map_update k (Some hd) acc)
      in
      loop rest ctxt l (empty_map (map_key_ty map))
      >>=? fun (res, ctxt) -> logged_return (Item (res, rest), ctxt)
  | (Map_iter body, Item (map, init)) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.map_to_list map))
      >>=? fun ctxt ->
      let l = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in
      let rec loop ctxt l stack =
        Lwt.return (Gas.consume ctxt Interp_costs.loop_iter)
        >>=? fun ctxt ->
        match l with
        | [] ->
            return (stack, ctxt)
        | hd :: tl ->
            step ?log ctxt step_constants body (Item (hd, stack))
            >>=? fun (stack, ctxt) -> loop ctxt tl stack
      in
      loop ctxt l init >>=? fun (res, ctxt) -> logged_return (res, ctxt)
  | (Map_mem, Item (v, Item (map, rest))) ->
      consume_gas_binop descr (map_mem, v, map) Interp_costs.map_mem rest ctxt
  | (Map_get, Item (v, Item (map, rest))) ->
      consume_gas_binop descr (map_get, v, map) Interp_costs.map_get rest ctxt
  | (Map_update, Item (k, Item (v, Item (map, rest)))) ->
      consume_gas_terop
        descr
        (map_update, k, v, map)
        Interp_costs.map_update
        rest
  | (Map_size, Item (map, rest)) ->
      consume_gas_unop
        descr
        (map_size, map)
        (fun _ -> Interp_costs.map_size)
        rest
        ctxt
  (* Big map operations *)
  | (Empty_big_map (tk, tv), rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.empty_map)
      >>=? fun ctxt ->
      logged_return
        (Item (Script_ir_translator.empty_big_map tk tv, rest), ctxt)
  | (Big_map_mem, Item (key, Item (map, rest))) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.map_mem key map.diff))
      >>=? fun ctxt ->
      Script_ir_translator.big_map_mem ctxt key map
      >>=? fun (res, ctxt) -> logged_return (Item (res, rest), ctxt)
  | (Big_map_get, Item (key, Item (map, rest))) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.map_get key map.diff))
      >>=? fun ctxt ->
      Script_ir_translator.big_map_get ctxt key map
      >>=? fun (res, ctxt) -> logged_return (Item (res, rest), ctxt)
  | (Big_map_update, Item (key, Item (maybe_value, Item (map, rest)))) ->
      consume_gas_terop
        descr
        (Script_ir_translator.big_map_update, key, maybe_value, map)
        (fun k v m -> Interp_costs.map_update k (Some v) m.diff)
        rest
  (* timestamp operations *)
  | (Add_seconds_to_timestamp, Item (n, Item (t, rest))) ->
      consume_gas_binop
        descr
        (Script_timestamp.add_delta, t, n)
        Interp_costs.add_timestamp
        rest
        ctxt
  | (Add_timestamp_to_seconds, Item (t, Item (n, rest))) ->
      consume_gas_binop
        descr
        (Script_timestamp.add_delta, t, n)
        Interp_costs.add_timestamp
        rest
        ctxt
  | (Sub_timestamp_seconds, Item (t, Item (s, rest))) ->
      consume_gas_binop
        descr
        (Script_timestamp.sub_delta, t, s)
        Interp_costs.sub_timestamp
        rest
        ctxt
  | (Diff_timestamps, Item (t1, Item (t2, rest))) ->
      consume_gas_binop
        descr
        (Script_timestamp.diff, t1, t2)
        Interp_costs.diff_timestamps
        rest
        ctxt
  (* string operations *)
  | (Concat_string_pair, Item (x, Item (y, rest))) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.concat_string [x; y]))
      >>=? fun ctxt ->
      let s = String.concat "" [x; y] in
      logged_return (Item (s, rest), ctxt)
  | (Concat_string, Item (ss, rest)) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.concat_string ss))
      >>=? fun ctxt ->
      let s = String.concat "" ss in
      logged_return (Item (s, rest), ctxt)
  | (Slice_string, Item (offset, Item (length, Item (s, rest)))) ->
      let s_length = Z.of_int (String.length s) in
      let offset = Script_int.to_zint offset in
      let length = Script_int.to_zint length in
      if Compare.Z.(offset < s_length && Z.add offset length <= s_length) then
        Lwt.return
          (Gas.consume ctxt (Interp_costs.slice_string (Z.to_int length)))
        >>=? fun ctxt ->
        logged_return
          ( Item (Some (String.sub s (Z.to_int offset) (Z.to_int length)), rest),
            ctxt )
      else
        Lwt.return (Gas.consume ctxt (Interp_costs.slice_string 0))
        >>=? fun ctxt -> logged_return (Item (None, rest), ctxt)
  | (String_size, Item (s, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.push)
      >>=? fun ctxt ->
      logged_return
        (Item (Script_int.(abs (of_int (String.length s))), rest), ctxt)
  (* bytes operations *)
  | (Concat_bytes_pair, Item (x, Item (y, rest))) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.concat_bytes [x; y]))
      >>=? fun ctxt ->
      let s = MBytes.concat "" [x; y] in
      logged_return (Item (s, rest), ctxt)
  | (Concat_bytes, Item (ss, rest)) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.concat_bytes ss))
      >>=? fun ctxt ->
      let s = MBytes.concat "" ss in
      logged_return (Item (s, rest), ctxt)
  | (Slice_bytes, Item (offset, Item (length, Item (s, rest)))) ->
      let s_length = Z.of_int (MBytes.length s) in
      let offset = Script_int.to_zint offset in
      let length = Script_int.to_zint length in
      if Compare.Z.(offset < s_length && Z.add offset length <= s_length) then
        Lwt.return
          (Gas.consume ctxt (Interp_costs.slice_string (Z.to_int length)))
        >>=? fun ctxt ->
        logged_return
          ( Item (Some (MBytes.sub s (Z.to_int offset) (Z.to_int length)), rest),
            ctxt )
      else
        Lwt.return (Gas.consume ctxt (Interp_costs.slice_string 0))
        >>=? fun ctxt -> logged_return (Item (None, rest), ctxt)
  | (Bytes_size, Item (s, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.push)
      >>=? fun ctxt ->
      logged_return
        (Item (Script_int.(abs (of_int (MBytes.length s))), rest), ctxt)
  (* currency operations *)
  | (Add_tez, Item (x, Item (y, rest))) ->
      Lwt.return (Gas.consume ctxt Interp_costs.int64_op)
      >>=? fun ctxt ->
      Lwt.return Tez.(x +? y)
      >>=? fun res -> logged_return (Item (res, rest), ctxt)
  | (Sub_tez, Item (x, Item (y, rest))) ->
      Lwt.return (Gas.consume ctxt Interp_costs.int64_op)
      >>=? fun ctxt ->
      Lwt.return Tez.(x -? y)
      >>=? fun res -> logged_return (Item (res, rest), ctxt)
  | (Mul_teznat, Item (x, Item (y, rest))) -> (
      Lwt.return (Gas.consume ctxt Interp_costs.int64_op)
      >>=? fun ctxt ->
      Lwt.return (Gas.consume ctxt Interp_costs.z_to_int64)
      >>=? fun ctxt ->
      match Script_int.to_int64 y with
      | None ->
          fail (Overflow (loc, get_log log))
      | Some y ->
          Lwt.return Tez.(x *? y)
          >>=? fun res -> logged_return (Item (res, rest), ctxt) )
  | (Mul_nattez, Item (y, Item (x, rest))) -> (
      Lwt.return (Gas.consume ctxt Interp_costs.int64_op)
      >>=? fun ctxt ->
      Lwt.return (Gas.consume ctxt Interp_costs.z_to_int64)
      >>=? fun ctxt ->
      match Script_int.to_int64 y with
      | None ->
          fail (Overflow (loc, get_log log))
      | Some y ->
          Lwt.return Tez.(x *? y)
          >>=? fun res -> logged_return (Item (res, rest), ctxt) )
  (* boolean operations *)
  | (Or, Item (x, Item (y, rest))) ->
      consume_gas_binop descr (( || ), x, y) Interp_costs.bool_binop rest ctxt
  | (And, Item (x, Item (y, rest))) ->
      consume_gas_binop descr (( && ), x, y) Interp_costs.bool_binop rest ctxt
  | (Xor, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Compare.Bool.( <> ), x, y)
        Interp_costs.bool_binop
        rest
        ctxt
  | (Not, Item (x, rest)) ->
      consume_gas_unop descr (not, x) Interp_costs.bool_unop rest ctxt
  (* integer operations *)
  | (Is_nat, Item (x, rest)) ->
      consume_gas_unop descr (Script_int.is_nat, x) Interp_costs.abs rest ctxt
  | (Abs_int, Item (x, rest)) ->
      consume_gas_unop descr (Script_int.abs, x) Interp_costs.abs rest ctxt
  | (Int_nat, Item (x, rest)) ->
      consume_gas_unop descr (Script_int.int, x) Interp_costs.int rest ctxt
  | (Neg_int, Item (x, rest)) ->
      consume_gas_unop descr (Script_int.neg, x) Interp_costs.neg rest ctxt
  | (Neg_nat, Item (x, rest)) ->
      consume_gas_unop descr (Script_int.neg, x) Interp_costs.neg rest ctxt
  | (Add_intint, Item (x, Item (y, rest))) ->
      consume_gas_binop descr (Script_int.add, x, y) Interp_costs.add rest ctxt
  | (Add_intnat, Item (x, Item (y, rest))) ->
      consume_gas_binop descr (Script_int.add, x, y) Interp_costs.add rest ctxt
  | (Add_natint, Item (x, Item (y, rest))) ->
      consume_gas_binop descr (Script_int.add, x, y) Interp_costs.add rest ctxt
  | (Add_natnat, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Script_int.add_n, x, y)
        Interp_costs.add
        rest
        ctxt
  | (Sub_int, Item (x, Item (y, rest))) ->
      consume_gas_binop descr (Script_int.sub, x, y) Interp_costs.sub rest ctxt
  | (Mul_intint, Item (x, Item (y, rest))) ->
      consume_gas_binop descr (Script_int.mul, x, y) Interp_costs.mul rest ctxt
  | (Mul_intnat, Item (x, Item (y, rest))) ->
      consume_gas_binop descr (Script_int.mul, x, y) Interp_costs.mul rest ctxt
  | (Mul_natint, Item (x, Item (y, rest))) ->
      consume_gas_binop descr (Script_int.mul, x, y) Interp_costs.mul rest ctxt
  | (Mul_natnat, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Script_int.mul_n, x, y)
        Interp_costs.mul
        rest
        ctxt
  | (Ediv_teznat, Item (x, Item (y, rest))) ->
      Lwt.return (Gas.consume ctxt Interp_costs.int64_to_z)
      >>=? fun ctxt ->
      let x = Script_int.of_int64 (Tez.to_mutez x) in
      consume_gas_binop
        descr
        ( (fun x y ->
            match Script_int.ediv x y with
            | None ->
                None
            | Some (q, r) -> (
              match (Script_int.to_int64 q, Script_int.to_int64 r) with
              | (Some q, Some r) -> (
                match (Tez.of_mutez q, Tez.of_mutez r) with
                | (Some q, Some r) ->
                    Some (q, r)
                (* Cannot overflow *)
                | _ ->
                    assert false )
              (* Cannot overflow *)
              | _ ->
                  assert false )),
          x,
          y )
        Interp_costs.div
        rest
        ctxt
  | (Ediv_tez, Item (x, Item (y, rest))) ->
      Lwt.return (Gas.consume ctxt Interp_costs.int64_to_z)
      >>=? fun ctxt ->
      Lwt.return (Gas.consume ctxt Interp_costs.int64_to_z)
      >>=? fun ctxt ->
      let x = Script_int.abs (Script_int.of_int64 (Tez.to_mutez x)) in
      let y = Script_int.abs (Script_int.of_int64 (Tez.to_mutez y)) in
      consume_gas_binop
        descr
        ( (fun x y ->
            match Script_int.ediv_n x y with
            | None ->
                None
            | Some (q, r) -> (
              match Script_int.to_int64 r with
              | None ->
                  assert false (* Cannot overflow *)
              | Some r -> (
                match Tez.of_mutez r with
                | None ->
                    assert false (* Cannot overflow *)
                | Some r ->
                    Some (q, r) ) )),
          x,
          y )
        Interp_costs.div
        rest
        ctxt
  | (Ediv_intint, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Script_int.ediv, x, y)
        Interp_costs.div
        rest
        ctxt
  | (Ediv_intnat, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Script_int.ediv, x, y)
        Interp_costs.div
        rest
        ctxt
  | (Ediv_natint, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Script_int.ediv, x, y)
        Interp_costs.div
        rest
        ctxt
  | (Ediv_natnat, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Script_int.ediv_n, x, y)
        Interp_costs.div
        rest
        ctxt
  | (Lsl_nat, Item (x, Item (y, rest))) -> (
      Lwt.return (Gas.consume ctxt (Interp_costs.shift_left x y))
      >>=? fun ctxt ->
      match Script_int.shift_left_n x y with
      | None ->
          fail (Overflow (loc, get_log log))
      | Some x ->
          logged_return (Item (x, rest), ctxt) )
  | (Lsr_nat, Item (x, Item (y, rest))) -> (
      Lwt.return (Gas.consume ctxt (Interp_costs.shift_right x y))
      >>=? fun ctxt ->
      match Script_int.shift_right_n x y with
      | None ->
          fail (Overflow (loc, get_log log))
      | Some r ->
          logged_return (Item (r, rest), ctxt) )
  | (Or_nat, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Script_int.logor, x, y)
        Interp_costs.logor
        rest
        ctxt
  | (And_nat, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Script_int.logand, x, y)
        Interp_costs.logand
        rest
        ctxt
  | (And_int_nat, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Script_int.logand, x, y)
        Interp_costs.logand
        rest
        ctxt
  | (Xor_nat, Item (x, Item (y, rest))) ->
      consume_gas_binop
        descr
        (Script_int.logxor, x, y)
        Interp_costs.logxor
        rest
        ctxt
  | (Not_int, Item (x, rest)) ->
      consume_gas_unop
        descr
        (Script_int.lognot, x)
        Interp_costs.lognot
        rest
        ctxt
  | (Not_nat, Item (x, rest)) ->
      consume_gas_unop
        descr
        (Script_int.lognot, x)
        Interp_costs.lognot
        rest
        ctxt
  (* control *)
  | (Seq (hd, tl), stack) ->
      step ?log ctxt step_constants hd stack
      >>=? fun (trans, ctxt) -> step ?log ctxt step_constants tl trans
  | (If (bt, _), Item (true, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.branch)
      >>=? fun ctxt -> step ?log ctxt step_constants bt rest
  | (If (_, bf), Item (false, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.branch)
      >>=? fun ctxt -> step ?log ctxt step_constants bf rest
  | (Loop body, Item (true, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle)
      >>=? fun ctxt ->
      step ?log ctxt step_constants body rest
      >>=? fun (trans, ctxt) -> step ?log ctxt step_constants descr trans
  | (Loop _, Item (false, rest)) ->
      logged_return (rest, ctxt)
  | (Loop_left body, Item (L v, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle)
      >>=? fun ctxt ->
      step ?log ctxt step_constants body (Item (v, rest))
      >>=? fun (trans, ctxt) -> step ?log ctxt step_constants descr trans
  | (Loop_left _, Item (R v, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle)
      >>=? fun ctxt -> logged_return (Item (v, rest), ctxt)
  | (Dip b, Item (ign, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.stack_op)
      >>=? fun ctxt ->
      step ?log ctxt step_constants b rest
      >>=? fun (res, ctxt) -> logged_return (Item (ign, res), ctxt)
  | (Exec, Item (arg, Item (lam, rest))) ->
      Lwt.return (Gas.consume ctxt Interp_costs.exec)
      >>=? fun ctxt ->
      interp ?log ctxt step_constants lam arg
      >>=? fun (res, ctxt) -> logged_return (Item (res, rest), ctxt)
  | (Apply capture_ty, Item (capture, Item (lam, rest))) -> (
      Lwt.return (Gas.consume ctxt Interp_costs.apply)
      >>=? fun ctxt ->
      let (Lam (descr, expr)) = lam in
      let (Item_t (full_arg_ty, _, _)) = descr.bef in
      unparse_data ctxt Optimized capture_ty capture
      >>=? fun (const_expr, ctxt) ->
      unparse_ty ctxt capture_ty
      >>=? fun (ty_expr, ctxt) ->
      match full_arg_ty with
      | Pair_t ((capture_ty, _, _), (arg_ty, _, _), _, _) ->
          let arg_stack_ty = Item_t (arg_ty, Empty_t, None) in
          let const_descr =
            ( {
                loc = descr.loc;
                bef = arg_stack_ty;
                aft = Item_t (capture_ty, arg_stack_ty, None);
                instr = Const capture;
              }
              : (_, _) descr )
          in
          let pair_descr =
            ( {
                loc = descr.loc;
                bef = Item_t (capture_ty, arg_stack_ty, None);
                aft = Item_t (full_arg_ty, Empty_t, None);
                instr = Cons_pair;
              }
              : (_, _) descr )
          in
          let seq_descr =
            ( {
                loc = descr.loc;
                bef = arg_stack_ty;
                aft = Item_t (full_arg_ty, Empty_t, None);
                instr = Seq (const_descr, pair_descr);
              }
              : (_, _) descr )
          in
          let full_descr =
            ( {
                loc = descr.loc;
                bef = arg_stack_ty;
                aft = descr.aft;
                instr = Seq (seq_descr, descr);
              }
              : (_, _) descr )
          in
          let full_expr =
            Micheline.Seq
              ( 0,
                [ Prim (0, I_PUSH, [ty_expr; const_expr], []);
                  Prim (0, I_PAIR, [], []);
                  expr ] )
          in
          let lam' = Lam (full_descr, full_expr) in
          logged_return (Item (lam', rest), ctxt)
      | _ ->
          assert false )
  | (Lambda lam, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.push)
      >>=? fun ctxt -> logged_return (Item (lam, rest), ctxt)
  | (Failwith tv, Item (v, _)) ->
      trace Cannot_serialize_failure (unparse_data ctxt Optimized tv v)
      >>=? fun (v, _ctxt) ->
      let v = Micheline.strip_locations v in
      fail (Reject (loc, v, get_log log))
  | (Nop, stack) ->
      logged_return (stack, ctxt)
  (* comparison *)
  | (Compare ty, Item (a, Item (b, rest))) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.compare ty a b))
      >>=? fun ctxt ->
      logged_return
        ( Item
            ( Script_int.of_int
              @@ Script_ir_translator.compare_comparable ty a b,
              rest ),
          ctxt )
  (* comparators *)
  | (Eq, Item (cmpres, rest)) ->
      let cmpres = Script_int.compare cmpres Script_int.zero in
      let cmpres = Compare.Int.(cmpres = 0) in
      Lwt.return (Gas.consume ctxt Interp_costs.compare_res)
      >>=? fun ctxt -> logged_return (Item (cmpres, rest), ctxt)
  | (Neq, Item (cmpres, rest)) ->
      let cmpres = Script_int.compare cmpres Script_int.zero in
      let cmpres = Compare.Int.(cmpres <> 0) in
      Lwt.return (Gas.consume ctxt Interp_costs.compare_res)
      >>=? fun ctxt -> logged_return (Item (cmpres, rest), ctxt)
  | (Lt, Item (cmpres, rest)) ->
      let cmpres = Script_int.compare cmpres Script_int.zero in
      let cmpres = Compare.Int.(cmpres < 0) in
      Lwt.return (Gas.consume ctxt Interp_costs.compare_res)
      >>=? fun ctxt -> logged_return (Item (cmpres, rest), ctxt)
  | (Le, Item (cmpres, rest)) ->
      let cmpres = Script_int.compare cmpres Script_int.zero in
      let cmpres = Compare.Int.(cmpres <= 0) in
      Lwt.return (Gas.consume ctxt Interp_costs.compare_res)
      >>=? fun ctxt -> logged_return (Item (cmpres, rest), ctxt)
  | (Gt, Item (cmpres, rest)) ->
      let cmpres = Script_int.compare cmpres Script_int.zero in
      let cmpres = Compare.Int.(cmpres > 0) in
      Lwt.return (Gas.consume ctxt Interp_costs.compare_res)
      >>=? fun ctxt -> logged_return (Item (cmpres, rest), ctxt)
  | (Ge, Item (cmpres, rest)) ->
      let cmpres = Script_int.compare cmpres Script_int.zero in
      let cmpres = Compare.Int.(cmpres >= 0) in
      Lwt.return (Gas.consume ctxt Interp_costs.compare_res)
      >>=? fun ctxt -> logged_return (Item (cmpres, rest), ctxt)
  (* packing *)
  | (Pack t, Item (value, rest)) ->
      Script_ir_translator.pack_data ctxt t value
      >>=? fun (bytes, ctxt) -> logged_return (Item (bytes, rest), ctxt)
  | (Unpack t, Item (bytes, rest)) ->
      Lwt.return (Gas.check_enough ctxt (Script.serialized_cost bytes))
      >>=? fun () ->
      if
        Compare.Int.(MBytes.length bytes >= 1)
        && Compare.Int.(MBytes.get_uint8 bytes 0 = 0x05)
      then
        let bytes = MBytes.sub bytes 1 (MBytes.length bytes - 1) in
        match Data_encoding.Binary.of_bytes Script.expr_encoding bytes with
        | None ->
            Lwt.return (Gas.consume ctxt (Interp_costs.unpack_failed bytes))
            >>=? fun ctxt -> logged_return (Item (None, rest), ctxt)
        | Some expr -> (
            Lwt.return (Gas.consume ctxt (Script.deserialized_cost expr))
            >>=? fun ctxt ->
            parse_data ctxt ~legacy:false t (Micheline.root expr)
            >>= function
            | Ok (value, ctxt) ->
                logged_return (Item (Some value, rest), ctxt)
            | Error _ignored ->
                Lwt.return
                  (Gas.consume ctxt (Interp_costs.unpack_failed bytes))
                >>=? fun ctxt -> logged_return (Item (None, rest), ctxt) )
      else logged_return (Item (None, rest), ctxt)
  (* protocol *)
  | (Address, Item ((_, address), rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.address)
      >>=? fun ctxt -> logged_return (Item (address, rest), ctxt)
  | (Contract (t, entrypoint), Item (contract, rest)) -> (
      Lwt.return (Gas.consume ctxt Interp_costs.contract)
      >>=? fun ctxt ->
      match (contract, entrypoint) with
      | ((contract, "default"), entrypoint)
      | ((contract, entrypoint), "default") ->
          Script_ir_translator.parse_contract_for_script
            ~legacy:false
            ctxt
            loc
            t
            contract
            ~entrypoint
          >>=? fun (ctxt, maybe_contract) ->
          logged_return (Item (maybe_contract, rest), ctxt)
      | _ ->
          logged_return (Item (None, rest), ctxt) )
  | ( Transfer_tokens,
      Item (p, Item (amount, Item ((tp, (destination, entrypoint)), rest))) )
    ->
      Lwt.return (Gas.consume ctxt Interp_costs.transfer)
      >>=? fun ctxt ->
      collect_big_maps ctxt tp p
      >>=? fun (to_duplicate, ctxt) ->
      let to_update = no_big_map_id in
      extract_big_map_diff
        ctxt
        Optimized
        tp
        p
        ~to_duplicate
        ~to_update
        ~temporary:true
      >>=? fun (p, big_map_diff, ctxt) ->
      unparse_data ctxt Optimized tp p
      >>=? fun (p, ctxt) ->
      let operation =
        Transaction
          {
            amount;
            destination;
            entrypoint;
            parameters = Script.lazy_expr (Micheline.strip_locations p);
          }
      in
      Lwt.return (fresh_internal_nonce ctxt)
      >>=? fun (ctxt, nonce) ->
      logged_return
        ( Item
            ( ( Internal_operation
                  {source = step_constants.self; operation; nonce},
                big_map_diff ),
              rest ),
          ctxt )
  | ( Create_account,
      Item (manager, Item (delegate, Item (_delegatable, Item (credit, rest))))
    ) ->
      Lwt.return (Gas.consume ctxt Interp_costs.create_account)
      >>=? fun ctxt ->
      Contract.fresh_contract_from_current_nonce ctxt
      >>=? fun (ctxt, contract) ->
      (* store in optimized binary representation - as unparsed with [Optimized]. *)
      let manager_bytes =
        Data_encoding.Binary.to_bytes_exn
          Signature.Public_key_hash.encoding
          manager
      in
      let storage =
        Script_repr.lazy_expr @@ Micheline.strip_locations
        @@ Micheline.Bytes (0, manager_bytes)
      in
      let script = {code = Legacy_support.manager_script_code; storage} in
      let operation =
        Origination {credit; delegate; preorigination = Some contract; script}
      in
      Lwt.return (fresh_internal_nonce ctxt)
      >>=? fun (ctxt, nonce) ->
      logged_return
        ( Item
            ( ( Internal_operation
                  {source = step_constants.self; operation; nonce},
                None ),
              Item ((contract, "default"), rest) ),
          ctxt )
  | (Implicit_account, Item (key, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.implicit_account)
      >>=? fun ctxt ->
      let contract = Contract.implicit_contract key in
      logged_return (Item ((Unit_t None, (contract, "default")), rest), ctxt)
  | ( Create_contract (storage_type, param_type, Lam (_, code), root_name),
      Item
        ( manager,
          Item
            ( delegate,
              Item
                ( spendable,
                  Item (delegatable, Item (credit, Item (init, rest))) ) ) ) )
    ->
      Lwt.return (Gas.consume ctxt Interp_costs.create_contract)
      >>=? fun ctxt ->
      unparse_ty ctxt param_type
      >>=? fun (unparsed_param_type, ctxt) ->
      let unparsed_param_type =
        Script_ir_translator.add_field_annot
          (Option.map ~f:(fun n -> `Field_annot n) root_name)
          None
          unparsed_param_type
      in
      unparse_ty ctxt storage_type
      >>=? fun (unparsed_storage_type, ctxt) ->
      let code =
        Script.lazy_expr
        @@ Micheline.strip_locations
             (Seq
                ( 0,
                  [ Prim (0, K_parameter, [unparsed_param_type], []);
                    Prim (0, K_storage, [unparsed_storage_type], []);
                    Prim (0, K_code, [code], []) ] ))
      in
      collect_big_maps ctxt storage_type init
      >>=? fun (to_duplicate, ctxt) ->
      let to_update = no_big_map_id in
      extract_big_map_diff
        ctxt
        Optimized
        storage_type
        init
        ~to_duplicate
        ~to_update
        ~temporary:true
      >>=? fun (init, big_map_diff, ctxt) ->
      unparse_data ctxt Optimized storage_type init
      >>=? fun (storage, ctxt) ->
      let storage = Script.lazy_expr @@ Micheline.strip_locations storage in
      ( if spendable then
        Legacy_support.add_do
          ~manager_pkh:manager
          ~script_code:code
          ~script_storage:storage
      else if delegatable then
        Legacy_support.add_set_delegate
          ~manager_pkh:manager
          ~script_code:code
          ~script_storage:storage
      else if Legacy_support.has_default_entrypoint code then
        Legacy_support.add_root_entrypoint code
        >>=? fun code -> return (code, storage)
      else return (code, storage) )
      >>=? fun (code, storage) ->
      Contract.fresh_contract_from_current_nonce ctxt
      >>=? fun (ctxt, contract) ->
      let operation =
        Origination
          {
            credit;
            delegate;
            preorigination = Some contract;
            script = {code; storage};
          }
      in
      Lwt.return (fresh_internal_nonce ctxt)
      >>=? fun (ctxt, nonce) ->
      logged_return
        ( Item
            ( ( Internal_operation
                  {source = step_constants.self; operation; nonce},
                big_map_diff ),
              Item ((contract, "default"), rest) ),
          ctxt )
  | ( Create_contract_2 (storage_type, param_type, Lam (_, code), root_name),
      (* Removed the instruction's arguments manager, spendable and delegatable *)
    Item (delegate, Item (credit, Item (init, rest))) ) ->
      Lwt.return (Gas.consume ctxt Interp_costs.create_contract)
      >>=? fun ctxt ->
      unparse_ty ctxt param_type
      >>=? fun (unparsed_param_type, ctxt) ->
      let unparsed_param_type =
        Script_ir_translator.add_field_annot
          (Option.map ~f:(fun n -> `Field_annot n) root_name)
          None
          unparsed_param_type
      in
      unparse_ty ctxt storage_type
      >>=? fun (unparsed_storage_type, ctxt) ->
      let code =
        Micheline.strip_locations
          (Seq
             ( 0,
               [ Prim (0, K_parameter, [unparsed_param_type], []);
                 Prim (0, K_storage, [unparsed_storage_type], []);
                 Prim (0, K_code, [code], []) ] ))
      in
      collect_big_maps ctxt storage_type init
      >>=? fun (to_duplicate, ctxt) ->
      let to_update = no_big_map_id in
      extract_big_map_diff
        ctxt
        Optimized
        storage_type
        init
        ~to_duplicate
        ~to_update
        ~temporary:true
      >>=? fun (init, big_map_diff, ctxt) ->
      unparse_data ctxt Optimized storage_type init
      >>=? fun (storage, ctxt) ->
      let storage = Micheline.strip_locations storage in
      Contract.fresh_contract_from_current_nonce ctxt
      >>=? fun (ctxt, contract) ->
      let operation =
        Origination
          {
            credit;
            delegate;
            preorigination = Some contract;
            script =
              {
                code = Script.lazy_expr code;
                storage = Script.lazy_expr storage;
              };
          }
      in
      Lwt.return (fresh_internal_nonce ctxt)
      >>=? fun (ctxt, nonce) ->
      logged_return
        ( Item
            ( ( Internal_operation
                  {source = step_constants.self; operation; nonce},
                big_map_diff ),
              Item ((contract, "default"), rest) ),
          ctxt )
  | (Set_delegate, Item (delegate, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.create_account)
      >>=? fun ctxt ->
      let operation = Delegation delegate in
      Lwt.return (fresh_internal_nonce ctxt)
      >>=? fun (ctxt, nonce) ->
      logged_return
        ( Item
            ( ( Internal_operation
                  {source = step_constants.self; operation; nonce},
                None ),
              rest ),
          ctxt )
  | (Balance, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.balance)
      >>=? fun ctxt ->
      Contract.get_balance ctxt step_constants.self
      >>=? fun balance -> logged_return (Item (balance, rest), ctxt)
  | (Now, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.now)
      >>=? fun ctxt ->
      let now = Script_timestamp.now ctxt in
      logged_return (Item (now, rest), ctxt)
  | (Check_signature, Item (key, Item (signature, Item (message, rest)))) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.check_signature key message))
      >>=? fun ctxt ->
      let res = Signature.check key signature message in
      logged_return (Item (res, rest), ctxt)
  | (Hash_key, Item (key, rest)) ->
      Lwt.return (Gas.consume ctxt Interp_costs.hash_key)
      >>=? fun ctxt ->
      logged_return (Item (Signature.Public_key.hash key, rest), ctxt)
  | (Blake2b, Item (bytes, rest)) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.hash_blake2b bytes))
      >>=? fun ctxt ->
      let hash = Raw_hashes.blake2b bytes in
      logged_return (Item (hash, rest), ctxt)
  | (Sha256, Item (bytes, rest)) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.hash_sha256 bytes))
      >>=? fun ctxt ->
      let hash = Raw_hashes.sha256 bytes in
      logged_return (Item (hash, rest), ctxt)
  | (Sha512, Item (bytes, rest)) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.hash_sha512 bytes))
      >>=? fun ctxt ->
      let hash = Raw_hashes.sha512 bytes in
      logged_return (Item (hash, rest), ctxt)
  | (Steps_to_quota, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.steps_to_quota)
      >>=? fun ctxt ->
      let steps =
        match Gas.level ctxt with
        | Limited {remaining} ->
            remaining
        | Unaccounted ->
            Z.of_string "99999999"
      in
      logged_return (Item (Script_int.(abs (of_zint steps)), rest), ctxt)
  | (Source, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.source)
      >>=? fun ctxt ->
      logged_return (Item ((step_constants.payer, "default"), rest), ctxt)
  | (Sender, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.source)
      >>=? fun ctxt ->
      logged_return (Item ((step_constants.source, "default"), rest), ctxt)
  | (Self (t, entrypoint), rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.self)
      >>=? fun ctxt ->
      logged_return (Item ((t, (step_constants.self, entrypoint)), rest), ctxt)
  | (Amount, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.amount)
      >>=? fun ctxt -> logged_return (Item (step_constants.amount, rest), ctxt)
  | (Dig (n, n'), stack) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.stack_n_op n))
      >>=? fun ctxt ->
      interp_stack_prefix_preserving_operation
        (fun (Item (v, rest)) -> return (rest, v))
        n'
        stack
      >>=? fun (aft, x) -> logged_return (Item (x, aft), ctxt)
  | (Dug (n, n'), Item (v, rest)) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.stack_n_op n))
      >>=? fun ctxt ->
      interp_stack_prefix_preserving_operation
        (fun stk -> return (Item (v, stk), ()))
        n'
        rest
      >>=? fun (aft, ()) -> logged_return (aft, ctxt)
  | (Dipn (n, n', b), stack) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.stack_n_op n))
      >>=? fun ctxt ->
      interp_stack_prefix_preserving_operation
        (fun stk ->
          step ?log ctxt step_constants b stk
          >>=? fun (res, ctxt') -> return (res, ctxt'))
        n'
        stack
      >>=? fun (aft, ctxt') -> logged_return (aft, ctxt')
  | (Dropn (n, n'), stack) ->
      Lwt.return (Gas.consume ctxt (Interp_costs.stack_n_op n))
      >>=? fun ctxt ->
      interp_stack_prefix_preserving_operation
        (fun stk -> return (stk, stk))
        n'
        stack
      >>=? fun (_, rest) -> logged_return (rest, ctxt)
  | (ChainId, rest) ->
      Lwt.return (Gas.consume ctxt Interp_costs.chain_id)
      >>=? fun ctxt ->
      logged_return (Item (step_constants.chain_id, rest), ctxt)

and interp :
    type p r.
    ?log:execution_trace ref ->
    context ->
    step_constants ->
    (p, r) lambda ->
    p ->
    (r * context) tzresult Lwt.t =
 fun ?log ctxt step_constants (Lam (code, _)) arg ->
  let stack = Item (arg, Empty) in
  ( match log with
  | None ->
      return_unit
  | Some log ->
      trace Cannot_serialize_log (unparse_stack ctxt (stack, code.bef))
      >>=? fun stack ->
      log := (code.loc, Gas.level ctxt, stack) :: !log ;
      return_unit )
  >>=? fun () ->
  step ?log ctxt step_constants code stack
  >>=? fun (Item (ret, Empty), ctxt) -> return (ret, ctxt)

(* ---- contract handling ---------------------------------------------------*)
and execute ?log ctxt mode step_constants ~entrypoint unparsed_script arg :
    ( Script.expr
    * packed_internal_operation list
    * context
    * Contract.big_map_diff option )
    tzresult
    Lwt.t =
  parse_script ctxt unparsed_script ~legacy:true
  >>=? fun (Ex_script {code; arg_type; storage; storage_type; root_name}, ctxt) ->
  trace
    (Bad_contract_parameter step_constants.self)
    (Lwt.return (find_entrypoint arg_type ~root_name entrypoint))
  >>=? fun (box, _) ->
  trace
    (Bad_contract_parameter step_constants.self)
    (parse_data ctxt ~legacy:false arg_type (box arg))
  >>=? fun (arg, ctxt) ->
  Script.force_decode ctxt unparsed_script.code
  >>=? fun (script_code, ctxt) ->
  Script_ir_translator.collect_big_maps ctxt arg_type arg
  >>=? fun (to_duplicate, ctxt) ->
  Script_ir_translator.collect_big_maps ctxt storage_type storage
  >>=? fun (to_update, ctxt) ->
  trace
    (Runtime_contract_error (step_constants.self, script_code))
    (interp ?log ctxt step_constants code (arg, storage))
  >>=? fun ((ops, storage), ctxt) ->
  Script_ir_translator.extract_big_map_diff
    ctxt
    mode
    ~temporary:false
    ~to_duplicate
    ~to_update
    storage_type
    storage
  >>=? fun (storage, big_map_diff, ctxt) ->
  trace Cannot_serialize_storage (unparse_data ctxt mode storage_type storage)
  >>=? fun (storage, ctxt) ->
  let (ops, op_diffs) = List.split ops in
  let big_map_diff =
    match
      List.flatten
        (List.map (Option.unopt ~default:[]) (op_diffs @ [big_map_diff]))
    with
    | [] ->
        None
    | diff ->
        Some diff
  in
  return (Micheline.strip_locations storage, ops, ctxt, big_map_diff)

type execution_result = {
  ctxt : context;
  storage : Script.expr;
  big_map_diff : Contract.big_map_diff option;
  operations : packed_internal_operation list;
}

let trace ctxt mode step_constants ~script ~entrypoint ~parameter =
  let log = ref [] in
  execute
    ~log
    ctxt
    mode
    step_constants
    ~entrypoint
    script
    (Micheline.root parameter)
  >>=? fun (storage, operations, ctxt, big_map_diff) ->
  let trace = List.rev !log in
  return ({ctxt; storage; big_map_diff; operations}, trace)

let execute ctxt mode step_constants ~script ~entrypoint ~parameter =
  execute
    ctxt
    mode
    step_constants
    ~entrypoint
    script
    (Micheline.root parameter)
  >>=? fun (storage, operations, ctxt, big_map_diff) ->
  return {ctxt; storage; big_map_diff; operations}
script_interpreter_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Import Script.

Import Script_typed_ir.

Import Script_ir_translator.

Definition execution_trace :=
  list
    (Tezos_raw_protocol_alpha.Alpha_context.Script.location *
      Tezos_raw_protocol_alpha.Alpha_context.Gas.t *
      list (Tezos_raw_protocol_alpha.Alpha_context.Script.expr * option string)).

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  let trace_encoding :=
    op_atat
      (let arg := list in
      fun eta => arg None eta)
      (obj3 (req None None "location" % string Script.location_encoding)
        (req None None "gas" % string Gas.encoding)
        (req None None "stack" % string
          (list None
            (obj2 (req None None "item" % string Script.expr_encoding)
              (opt None None "annot" % string string))))) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.script_rejected" % string "Script failed" % string
      "A FAILWITH instruction was reached" % string None
      (obj3 (req None None "location" % string Script.location_encoding)
        (req None None "with" % string Script.expr_encoding)
        (opt None None "trace" % string trace_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Reject loc v
            trace => Some (loc, v, trace)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, v, trace) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Reject loc v
          trace) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.script_overflow" % string
      "Script failed (overflow error)" % string
      "A FAIL instruction was reached due to the detection of an overflow" %
        string None
      (obj2 (req None None "location" % string Script.location_encoding)
        (opt None None "trace" % string trace_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Overflow loc
            trace => Some (loc, trace)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, trace) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Overflow loc
          trace) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.runtime_error" % string
      "Script runtime error" % string
      "Toplevel error for all runtime script errors" % string None
      (obj2 (req None None "contract_handle" % string Contract.encoding)
        (req None None "contract_code" % string Script.expr_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Runtime_contract_error
            contract expr => Some (contract, expr)
        | _ => None
        end)
      (fun function_parameter =>
        let '(contract, expr) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Runtime_contract_error
          contract expr) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.bad_contract_parameter" % string
      "Contract supplied an invalid parameter" % string
      "Either no parameter was supplied to a contract with a non-unit parameter type, a non-unit parameter was passed to an account, or a parameter was supplied of the wrong type"
        % string None
      (obj1 (req None None "contract" % string Contract.encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_contract_parameter
            c => Some c
        | _ => None
        end)
      (fun c =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_contract_parameter
          c) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.cannot_serialize_log" % string
      "Not enough gas to serialize execution trace" % string
      "Execution trace with stacks was to big to be serialized with the provided gas"
        % string None Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_log
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_log)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.cannot_serialize_failure" % string
      "Not enough gas to serialize argument of FAILWITH" % string
      "Argument of FAILWITH was too big to be serialized with the provided gas"
        % string None Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_failure
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_failure)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "michelson_v1.cannot_serialize_storage" % string
    "Not enough gas to serialize execution storage" % string
    "The returned storage was too big to be serialized with the provided gas" %
      string None Data_encoding.empty
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_storage
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_storage).

Reserved Notation "'stack".

Inductive stack_gadt : Type :=
| Item : forall {ty : Type}, ty -> stack_gadt -> stack_gadt
| Empty : stack_gadt

where "'stack" := (fun (tys : Type) => stack_gadt).

Definition stack := 'stack.

Definition unparse_stack {A : Type}
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (function_parameter :
    stack A * Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list (Tezos_raw_protocol_alpha.Alpha_context.Script.expr * option string))) :=
  let '(stack, stack_ty) := function_parameter in
  let ctxt := Gas.set_unlimited ctxt in
  let fix unparse_stack {a : Type}
    (function_parameter :
    stack a * Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty a)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (list
          (Tezos_raw_protocol_alpha.Alpha_context.Script.expr * option string))) :=
    match function_parameter with
    | (Empty, Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t) => return_nil
    |
      (Item v rest,
        Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ty rest_ty annot) =>
      op_gtgteqquestion
        (unparse_data ctxt
          Tezos_raw_protocol_alpha.Script_ir_translator.Readable ty v)
        (fun function_parameter =>
          let '(data, _ctxt) := function_parameter in
          op_gtgteqquestion (unparse_stack (rest, rest_ty))
            (fun rest =>
              let annot :=
                match Script_ir_annot.unparse_var_annot annot with
                | [] => None
                | cons a [] => Some a
                | _ =>
                  (* ❌ Assert instruction is not handled. *)
                  assert false
                end in
              let data := Micheline.strip_locations data in
              __return (cons (data, annot) rest)))
    end in
  unparse_stack (stack, stack_ty).

Module Interp_costs := Michelson_v1_gas.Cost_of.Interpreter.

Fixpoint interp_stack_prefix_preserving_operation
  {aft bef faft fbef result : Type}
  (f :
    stack fbef ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (stack faft * result)))
  (n :
    Tezos_raw_protocol_alpha.Script_typed_ir.stack_prefix_preservation_witness
      fbef faft bef aft) (stk : stack bef)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (stack aft * result)) :=
  match (n, stk) with
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
      (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
        (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
          (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
            (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
              (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                          (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                            (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                              (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                                (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
                                    n))))))))))))))),
      Item v0
        (Item v1
          (Item v2
            (Item v3
              (Item v4
                (Item v5
                  (Item v6
                    (Item v7
                      (Item v8
                        (Item v9
                          (Item va
                            (Item vb
                              (Item vc (Item vd (Item ve (Item vf rest))))))))))))))))
    =>
    op_gtgteqquestion (interp_stack_prefix_preserving_operation f n rest)
      (fun function_parameter =>
        let '(rest', result) := function_parameter in
        __return
          ((Item v0
            (Item v1
              (Item v2
                (Item v3
                  (Item v4
                    (Item v5
                      (Item v6
                        (Item v7
                          (Item v8
                            (Item v9
                              (Item va
                                (Item vb
                                  (Item vc (Item vd (Item ve (Item vf rest')))))))))))))))),
            result))
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
      (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
        (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix
          (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix n))),
      Item v0 (Item v1 (Item v2 (Item v3 rest)))) =>
    op_gtgteqquestion (interp_stack_prefix_preserving_operation f n rest)
      (fun function_parameter =>
        let '(rest', result) := function_parameter in
        __return ((Item v0 (Item v1 (Item v2 (Item v3 rest')))), result))
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Prefix n, Item v rest) =>
    op_gtgteqquestion (interp_stack_prefix_preserving_operation f n rest)
      (fun function_parameter =>
        let '(rest', result) := function_parameter in
        __return ((Item v rest'), result))
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Rest, v) => f v
  end.

Record step_constants := {
  source : Tezos_raw_protocol_alpha.Alpha_context.Contract.t;
  payer : Tezos_raw_protocol_alpha.Alpha_context.Contract.t;
  self : Tezos_raw_protocol_alpha.Alpha_context.Contract.t;
  amount : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
  chain_id :
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
  }.

Fixpoint step {a b : Type}
  (log :
    option
      (Tezos_protocol_environment_alpha__Environment.Pervasives.ref
        execution_trace))
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (step_constants : step_constants)
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.descr b a)
  : stack b ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (stack a * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let '{| loc := loc; instr := instr |} as descr := function_parameter in
  fun stack =>
    op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.cycle))
      (fun ctxt =>
        let logged_return
          (descr : Tezos_raw_protocol_alpha.Script_typed_ir.descr b a)
          (function_parameter :
          stack a * Tezos_raw_protocol_alpha.Alpha_context.context)
          : Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (stack a * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
          let '(ret, ctxt) := function_parameter in
          match log with
          | None => __return (ret, ctxt)
          | Some log =>
            op_gtgteqquestion
              (trace
                Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_log
                (unparse_stack ctxt (ret, (aft descr))))
              (fun stack =>
                (* ❌ Sequences of instructions are not handled (operator ";") *)
                let _ :=
                  op_coloneq log
                    (cons ((loc descr), (Gas.level ctxt), stack)
                      (op_exclamation log)) in
                __return (ret, ctxt))
          end in
        let get_log
          (log :
          option
            (Tezos_protocol_environment_alpha__Environment.Pervasives.ref
              execution_trace))
          : option
            (list
              (Tezos_raw_protocol_alpha.Alpha_context.Script.location *
                Tezos_raw_protocol_alpha.Alpha_context.Gas.t *
                list
                  (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
                    option string))) :=
          Option.map (fun l => List.rev (op_exclamation l)) log in
        let consume_gas_terop {C D E arg1 arg2 arg3 rest ret : Type}
          (descr :
          Tezos_raw_protocol_alpha.Script_typed_ir.descr (C * (D * (E * rest)))
            (ret * rest)) (function_parameter :
          (arg1 -> arg2 -> arg3 -> ret) * arg1 * arg2 * arg3)
          : (arg1 ->
            arg2 -> arg3 -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost) ->
            stack rest ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                  (stack (ret * rest) *
                    Tezos_raw_protocol_alpha.Alpha_context.context)) :=
          let '(op, x1, x2, x3) := function_parameter in
          fun cost_func =>
            fun rest =>
              op_gtgteqquestion
                (Lwt.__return (Gas.consume ctxt (cost_func x1 x2 x3)))
                (fun ctxt =>
                  logged_return descr ((Item (op x1 x2 x3) rest), ctxt)) in
        let consume_gas_binop {C D arg1 arg2 rest ret : Type}
          (descr :
          Tezos_raw_protocol_alpha.Script_typed_ir.descr (C * (D * rest))
            (ret * rest)) (function_parameter :
          (arg1 -> arg2 -> ret) * arg1 * arg2)
          : (arg1 -> arg2 -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost) ->
            stack rest ->
              Tezos_raw_protocol_alpha.Alpha_context.context ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                    (stack (ret * rest) *
                      Tezos_raw_protocol_alpha.Alpha_context.context)) :=
          let '(op, x1, x2) := function_parameter in
          fun cost_func =>
            fun rest =>
              fun ctxt =>
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt (cost_func x1 x2)))
                  (fun ctxt =>
                    logged_return descr ((Item (op x1 x2) rest), ctxt)) in
        let consume_gas_unop {C arg rest ret : Type}
          (descr :
          Tezos_raw_protocol_alpha.Script_typed_ir.descr (C * rest) (ret * rest))
          (function_parameter : (arg -> ret) * arg)
          : (arg -> Tezos_raw_protocol_alpha.Alpha_context.Gas.cost) ->
            stack rest ->
              Tezos_raw_protocol_alpha.Alpha_context.context ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                    (stack (ret * rest) *
                      Tezos_raw_protocol_alpha.Alpha_context.context)) :=
          let '(op, arg) := function_parameter in
          fun cost_func =>
            fun rest =>
              fun ctxt =>
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt (cost_func arg)))
                  (fun ctxt => logged_return descr ((Item (op arg) rest), ctxt))
          in
        let logged_return := logged_return descr in
        match (instr, stack) with
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Drop, Item _ rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.stack_op))
            (fun ctxt => logged_return (rest, ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Dup, Item v rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.stack_op))
            (fun ctxt => logged_return ((Item v (Item v rest)), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Swap, Item vi (Item vo rest))
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.stack_op))
            (fun ctxt => logged_return ((Item vo (Item vi rest)), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Const v, rest) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.push))
            (fun ctxt => logged_return ((Item v rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Cons_some, Item v rest) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.wrap))
            (fun ctxt => logged_return ((Item (Some v) rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Cons_none _, rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.variant_no_data))
            (fun ctxt => logged_return ((Item None rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.If_none bt _, Item None rest)
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.branch))
            (fun ctxt => step log ctxt step_constants bt rest)
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.If_none _ bf,
            Item (Some v) rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.branch))
            (fun ctxt => step log ctxt step_constants bf (Item v rest))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Cons_pair,
            Item a (Item b rest)) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.pair))
            (fun ctxt => logged_return ((Item (a, b) rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Seq {|
            instr := Tezos_raw_protocol_alpha.Script_typed_ir.Dup |} {|
            instr :=
              Tezos_raw_protocol_alpha.Script_typed_ir.Seq {|
                instr := Tezos_raw_protocol_alpha.Script_typed_ir.Car
                  |} {|
                instr :=
                  Tezos_raw_protocol_alpha.Script_typed_ir.Seq
                    {|
                    instr :=
                      Tezos_raw_protocol_alpha.Script_typed_ir.Dip
                        {|
                        instr :=
                          Tezos_raw_protocol_alpha.Script_typed_ir.Cdr
                          |}
                      |}
                    {|
                    instr := Tezos_raw_protocol_alpha.Script_typed_ir.Nop
                      |}
                  |}
              |}, Item (a, b) rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.pair_access))
            (fun ctxt => logged_return ((Item a (Item b rest)), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Car, Item (a, _) rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.pair_access))
            (fun ctxt => logged_return ((Item a rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Cdr, Item (_, b) rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.pair_access))
            (fun ctxt => logged_return ((Item b rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Left, Item v rest) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.wrap))
            (fun ctxt =>
              logged_return
                ((Item (Tezos_raw_protocol_alpha.Script_typed_ir.L v) rest),
                  ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Right, Item v rest) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.wrap))
            (fun ctxt =>
              logged_return
                ((Item (Tezos_raw_protocol_alpha.Script_typed_ir.R v) rest),
                  ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.If_left bt _,
            Item (Tezos_raw_protocol_alpha.Script_typed_ir.L v) rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.branch))
            (fun ctxt => step log ctxt step_constants bt (Item v rest))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.If_left _ bf,
            Item (Tezos_raw_protocol_alpha.Script_typed_ir.R v) rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.branch))
            (fun ctxt => step log ctxt step_constants bf (Item v rest))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Cons_list,
            Item hd (Item tl rest)) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.cons))
            (fun ctxt => logged_return ((Item (cons hd tl) rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Nil, rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.variant_no_data))
            (fun ctxt => logged_return ((Item [] rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.If_cons _ bf, Item [] rest)
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.branch))
            (fun ctxt => step log ctxt step_constants bf rest)
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.If_cons bt _,
            Item (cons hd tl) rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.branch))
            (fun ctxt =>
              step log ctxt step_constants bt (Item hd (Item tl rest)))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.List_map body, Item l rest)
          =>
          let fix loop
            (rest : stack op_dollar49) (ctxt :
            Tezos_raw_protocol_alpha__Alpha_context.context) (l :
            list op_dollar48) (acc : list op_dollar50)
            : Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                (stack (list op_dollar50 * op_dollar49) *
                  Tezos_raw_protocol_alpha__Alpha_context.context)) :=
            op_gtgteqquestion
              (Lwt.__return (Gas.consume ctxt Interp_costs.loop_map))
              (fun ctxt =>
                match l with
                | [] => __return ((Item (List.rev acc) rest), ctxt)
                | cons hd tl =>
                  op_gtgteqquestion
                    (step log ctxt step_constants body (Item hd rest))
                    (fun function_parameter =>
                      let '(Item hd rest, ctxt) := function_parameter in
                      loop rest ctxt tl (cons hd acc))
                end) in
          op_gtgteqquestion (loop rest ctxt l [])
            (fun function_parameter =>
              let '(res, ctxt) := function_parameter in
              logged_return (res, ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.List_size, Item list rest)
          =>
          op_gtgteqquestion
            (Lwt.__return
              (List.fold_left
                (fun acc =>
                  fun function_parameter =>
                    let '_ := function_parameter in
                    op_gtgtquestion acc
                      (fun function_parameter =>
                        let '(size, ctxt) := function_parameter in
                        op_gtgtquestion
                          (Gas.consume ctxt Interp_costs.loop_size)
                          (fun ctxt => ok ((op_plus size 1), ctxt))))
                (ok (0, ctxt)) list))
            (fun function_parameter =>
              let '(len, ctxt) := function_parameter in
              logged_return ((Item (abs (of_int len)) rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.List_iter body, Item l init)
          =>
          let fix loop
            (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context) (l :
            list op_dollar53) (stack : stack op_dollar54)
            : Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                (stack op_dollar54 *
                  Tezos_raw_protocol_alpha__Alpha_context.context)) :=
            op_gtgteqquestion
              (Lwt.__return (Gas.consume ctxt Interp_costs.loop_iter))
              (fun ctxt =>
                match l with
                | [] => __return (stack, ctxt)
                | cons hd tl =>
                  op_gtgteqquestion
                    (step log ctxt step_constants body (Item hd stack))
                    (fun function_parameter =>
                      let '(stack, ctxt) := function_parameter in
                      loop ctxt tl stack)
                end) in
          op_gtgteqquestion (loop ctxt l init)
            (fun function_parameter =>
              let '(res, ctxt) := function_parameter in
              logged_return (res, ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Empty_set t, rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.empty_set))
            (fun ctxt => logged_return ((Item (empty_set t) rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Set_iter body, Item set init)
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.set_to_list set)))
            (fun ctxt =>
              let l :=
                List.rev (set_fold (fun e => fun acc => cons e acc) set []) in
              let fix loop
                (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context) (l :
                list op_dollar56) (stack : stack op_dollar57)
                : Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                    (stack op_dollar57 *
                      Tezos_raw_protocol_alpha__Alpha_context.context)) :=
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt Interp_costs.loop_iter))
                  (fun ctxt =>
                    match l with
                    | [] => __return (stack, ctxt)
                    | cons hd tl =>
                      op_gtgteqquestion
                        (step log ctxt step_constants body (Item hd stack))
                        (fun function_parameter =>
                          let '(stack, ctxt) := function_parameter in
                          loop ctxt tl stack)
                    end) in
              op_gtgteqquestion (loop ctxt l init)
                (fun function_parameter =>
                  let '(res, ctxt) := function_parameter in
                  logged_return (res, ctxt)))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Set_mem,
            Item v (Item set rest)) =>
          consume_gas_binop descr (set_mem, v, set) Interp_costs.set_mem rest
            ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Set_update,
            Item v (Item presence (Item set rest))) =>
          consume_gas_terop descr (set_update, v, presence, set)
            Interp_costs.set_update rest
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Set_size, Item set rest) =>
          consume_gas_unop descr (set_size, set)
            (fun function_parameter =>
              let '_ := function_parameter in
              Interp_costs.set_size) rest ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Empty_map t _, rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.empty_map))
            (fun ctxt => logged_return ((Item (empty_map t) rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Map_map body, Item map rest)
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.map_to_list map)))
            (fun ctxt =>
              let l :=
                List.rev
                  (map_fold (fun k => fun v => fun acc => cons (k, v) acc) map
                    []) in
              let fix loop
                (rest : stack op_dollar68) (ctxt :
                Tezos_raw_protocol_alpha__Alpha_context.context) (l :
                list (op_dollar66 * op_dollar67)) (acc :
                Tezos_raw_protocol_alpha.Script_typed_ir.map op_dollar66
                  op_dollar69)
                : Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                    (Tezos_raw_protocol_alpha.Script_typed_ir.map op_dollar66
                      op_dollar69 *
                      Tezos_raw_protocol_alpha__Alpha_context.context)) :=
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt Interp_costs.loop_map))
                  (fun ctxt =>
                    match l with
                    | [] => __return (acc, ctxt)
                    | cons ((k, _) as hd) tl =>
                      op_gtgteqquestion
                        (step log ctxt step_constants body (Item hd rest))
                        (fun function_parameter =>
                          let '(Item hd rest, ctxt) := function_parameter in
                          loop rest ctxt tl (map_update k (Some hd) acc))
                    end) in
              op_gtgteqquestion (loop rest ctxt l (empty_map (map_key_ty map)))
                (fun function_parameter =>
                  let '(res, ctxt) := function_parameter in
                  logged_return ((Item res rest), ctxt)))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Map_iter body, Item map init)
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.map_to_list map)))
            (fun ctxt =>
              let l :=
                List.rev
                  (map_fold (fun k => fun v => fun acc => cons (k, v) acc) map
                    []) in
              let fix loop
                (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context) (l :
                list (op_dollar70 * op_dollar71)) (stack : stack op_dollar72)
                : Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                    (stack op_dollar72 *
                      Tezos_raw_protocol_alpha__Alpha_context.context)) :=
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt Interp_costs.loop_iter))
                  (fun ctxt =>
                    match l with
                    | [] => __return (stack, ctxt)
                    | cons hd tl =>
                      op_gtgteqquestion
                        (step log ctxt step_constants body (Item hd stack))
                        (fun function_parameter =>
                          let '(stack, ctxt) := function_parameter in
                          loop ctxt tl stack)
                    end) in
              op_gtgteqquestion (loop ctxt l init)
                (fun function_parameter =>
                  let '(res, ctxt) := function_parameter in
                  logged_return (res, ctxt)))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Map_mem,
            Item v (Item map rest)) =>
          consume_gas_binop descr (map_mem, v, map) Interp_costs.map_mem rest
            ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Map_get,
            Item v (Item map rest)) =>
          consume_gas_binop descr (map_get, v, map) Interp_costs.map_get rest
            ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Map_update,
            Item k (Item v (Item map rest))) =>
          consume_gas_terop descr (map_update, k, v, map)
            Interp_costs.map_update rest
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Map_size, Item map rest) =>
          consume_gas_unop descr (map_size, map)
            (fun function_parameter =>
              let '_ := function_parameter in
              Interp_costs.map_size) rest ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Empty_big_map tk tv, rest)
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.empty_map))
            (fun ctxt =>
              logged_return
                ((Item (Script_ir_translator.empty_big_map tk tv) rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_mem,
            Item key (Item map rest)) =>
          op_gtgteqquestion
            (Lwt.__return
              (Gas.consume ctxt (Interp_costs.map_mem key (diff map))))
            (fun ctxt =>
              op_gtgteqquestion (Script_ir_translator.big_map_mem ctxt key map)
                (fun function_parameter =>
                  let '(res, ctxt) := function_parameter in
                  logged_return ((Item res rest), ctxt)))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_get,
            Item key (Item map rest)) =>
          op_gtgteqquestion
            (Lwt.__return
              (Gas.consume ctxt (Interp_costs.map_get key (diff map))))
            (fun ctxt =>
              op_gtgteqquestion (Script_ir_translator.big_map_get ctxt key map)
                (fun function_parameter =>
                  let '(res, ctxt) := function_parameter in
                  logged_return ((Item res rest), ctxt)))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_update,
            Item key (Item maybe_value (Item map rest))) =>
          consume_gas_terop descr
            (Script_ir_translator.big_map_update, key, maybe_value, map)
            (fun k =>
              fun v => fun m => Interp_costs.map_update k (Some v) (diff m))
            rest
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Add_seconds_to_timestamp,
            Item n (Item t rest)) =>
          consume_gas_binop descr (Script_timestamp.add_delta, t, n)
            Interp_costs.add_timestamp rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Add_timestamp_to_seconds,
            Item t (Item n rest)) =>
          consume_gas_binop descr (Script_timestamp.add_delta, t, n)
            Interp_costs.add_timestamp rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Sub_timestamp_seconds,
            Item t (Item s rest)) =>
          consume_gas_binop descr (Script_timestamp.sub_delta, t, s)
            Interp_costs.sub_timestamp rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Diff_timestamps,
            Item t1 (Item t2 rest)) =>
          consume_gas_binop descr (Script_timestamp.diff, t1, t2)
            Interp_costs.diff_timestamps rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Concat_string_pair,
            Item x (Item y rest)) =>
          op_gtgteqquestion
            (Lwt.__return
              (Gas.consume ctxt
                (Interp_costs.concat_string (cons x (cons y [])))))
            (fun ctxt =>
              let s := String.concat "" % string (cons x (cons y [])) in
              logged_return ((Item s rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Concat_string, Item ss rest)
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.concat_string ss)))
            (fun ctxt =>
              let s := String.concat "" % string ss in
              logged_return ((Item s rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Slice_string,
            Item offset (Item length (Item s rest))) =>
          let s_length := Z.of_int (String.length s) in
          let offset := Script_int.to_zint offset in
          let length := Script_int.to_zint length in
          if
            op_andand
              (Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
                offset s_length)
              (Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lteq)
                (Z.add offset length) s_length) then
            op_gtgteqquestion
              (Lwt.__return
                (Gas.consume ctxt (Interp_costs.slice_string (Z.to_int length))))
              (fun ctxt =>
                logged_return
                  ((Item
                    (Some (String.sub s (Z.to_int offset) (Z.to_int length)))
                    rest), ctxt))
          else
            op_gtgteqquestion
              (Lwt.__return (Gas.consume ctxt (Interp_costs.slice_string 0)))
              (fun ctxt => logged_return ((Item None rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.String_size, Item s rest) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.push))
            (fun ctxt =>
              logged_return ((Item (abs (of_int (String.length s))) rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Concat_bytes_pair,
            Item x (Item y rest)) =>
          op_gtgteqquestion
            (Lwt.__return
              (Gas.consume ctxt (Interp_costs.concat_bytes (cons x (cons y [])))))
            (fun ctxt =>
              let s := MBytes.concat "" % string (cons x (cons y [])) in
              logged_return ((Item s rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Concat_bytes, Item ss rest)
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.concat_bytes ss)))
            (fun ctxt =>
              let s := MBytes.concat "" % string ss in
              logged_return ((Item s rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Slice_bytes,
            Item offset (Item length (Item s rest))) =>
          let s_length := Z.of_int (MBytes.length s) in
          let offset := Script_int.to_zint offset in
          let length := Script_int.to_zint length in
          if
            op_andand
              (Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
                offset s_length)
              (Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lteq)
                (Z.add offset length) s_length) then
            op_gtgteqquestion
              (Lwt.__return
                (Gas.consume ctxt (Interp_costs.slice_string (Z.to_int length))))
              (fun ctxt =>
                logged_return
                  ((Item
                    (Some (MBytes.sub s (Z.to_int offset) (Z.to_int length)))
                    rest), ctxt))
          else
            op_gtgteqquestion
              (Lwt.__return (Gas.consume ctxt (Interp_costs.slice_string 0)))
              (fun ctxt => logged_return ((Item None rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_size, Item s rest) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.push))
            (fun ctxt =>
              logged_return ((Item (abs (of_int (MBytes.length s))) rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Add_tez,
            Item x (Item y rest)) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.int64_op))
            (fun ctxt =>
              op_gtgteqquestion (Lwt.__return (op_plusquestion x y))
                (fun res => logged_return ((Item res rest), ctxt)))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Sub_tez,
            Item x (Item y rest)) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.int64_op))
            (fun ctxt =>
              op_gtgteqquestion (Lwt.__return (op_minusquestion x y))
                (fun res => logged_return ((Item res rest), ctxt)))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Mul_teznat,
            Item x (Item y rest)) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.int64_op))
            (fun ctxt =>
              op_gtgteqquestion
                (Lwt.__return (Gas.consume ctxt Interp_costs.z_to_int64))
                (fun ctxt =>
                  match Script_int.to_int64 y with
                  | None =>
                    fail
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Overflow
                        loc (get_log log))
                  | Some y =>
                    op_gtgteqquestion (Lwt.__return (op_starquestion x y))
                      (fun res => logged_return ((Item res rest), ctxt))
                  end))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Mul_nattez,
            Item y (Item x rest)) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.int64_op))
            (fun ctxt =>
              op_gtgteqquestion
                (Lwt.__return (Gas.consume ctxt Interp_costs.z_to_int64))
                (fun ctxt =>
                  match Script_int.to_int64 y with
                  | None =>
                    fail
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Overflow
                        loc (get_log log))
                  | Some y =>
                    op_gtgteqquestion (Lwt.__return (op_starquestion x y))
                      (fun res => logged_return ((Item res rest), ctxt))
                  end))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Or, Item x (Item y rest)) =>
          consume_gas_binop descr (op_pipepipe, x, y) Interp_costs.bool_binop
            rest ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.And, Item x (Item y rest))
          =>
          consume_gas_binop descr (op_andand, x, y) Interp_costs.bool_binop rest
            ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Xor, Item x (Item y rest))
          =>
          consume_gas_binop descr
            (Tezos_protocol_environment_alpha__Environment.Compare.Bool.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_ltgt),
              x, y) Interp_costs.bool_binop rest ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Not, Item x rest) =>
          consume_gas_unop descr (not, x) Interp_costs.bool_unop rest ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Is_nat, Item x rest) =>
          consume_gas_unop descr (Script_int.is_nat, x) Interp_costs.abs rest
            ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Abs_int, Item x rest) =>
          consume_gas_unop descr (Script_int.abs, x) Interp_costs.abs rest ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Int_nat, Item x rest) =>
          consume_gas_unop descr (Script_int.int, x) Interp_costs.int rest ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Neg_int, Item x rest) =>
          consume_gas_unop descr (Script_int.neg, x) Interp_costs.neg rest ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Neg_nat, Item x rest) =>
          consume_gas_unop descr (Script_int.neg, x) Interp_costs.neg rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Add_intint,
            Item x (Item y rest)) =>
          consume_gas_binop descr (Script_int.add, x, y) Interp_costs.add rest
            ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Add_intnat,
            Item x (Item y rest)) =>
          consume_gas_binop descr (Script_int.add, x, y) Interp_costs.add rest
            ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Add_natint,
            Item x (Item y rest)) =>
          consume_gas_binop descr (Script_int.add, x, y) Interp_costs.add rest
            ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Add_natnat,
            Item x (Item y rest)) =>
          consume_gas_binop descr (Script_int.add_n, x, y) Interp_costs.add rest
            ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Sub_int,
            Item x (Item y rest)) =>
          consume_gas_binop descr (Script_int.sub, x, y) Interp_costs.sub rest
            ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Mul_intint,
            Item x (Item y rest)) =>
          consume_gas_binop descr (Script_int.mul, x, y) Interp_costs.mul rest
            ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Mul_intnat,
            Item x (Item y rest)) =>
          consume_gas_binop descr (Script_int.mul, x, y) Interp_costs.mul rest
            ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Mul_natint,
            Item x (Item y rest)) =>
          consume_gas_binop descr (Script_int.mul, x, y) Interp_costs.mul rest
            ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Mul_natnat,
            Item x (Item y rest)) =>
          consume_gas_binop descr (Script_int.mul_n, x, y) Interp_costs.mul rest
            ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_teznat,
            Item x (Item y rest)) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.int64_to_z))
            (fun ctxt =>
              let x := Script_int.of_int64 (Tez.to_mutez x) in
              consume_gas_binop descr
                ((fun x =>
                  fun y =>
                    match Script_int.ediv x y with
                    | None => None
                    | Some (q, r) =>
                      match ((Script_int.to_int64 q), (Script_int.to_int64 r))
                        with
                      | (Some q, Some r) =>
                        match ((Tez.of_mutez q), (Tez.of_mutez r)) with
                        | (Some q, Some r) => Some (q, r)
                        | _ =>
                          (* ❌ Assert instruction is not handled. *)
                          assert false
                        end
                      | _ =>
                        (* ❌ Assert instruction is not handled. *)
                        assert false
                      end
                    end), x, y) Interp_costs.div rest ctxt)
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_tez,
            Item x (Item y rest)) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.int64_to_z))
            (fun ctxt =>
              op_gtgteqquestion
                (Lwt.__return (Gas.consume ctxt Interp_costs.int64_to_z))
                (fun ctxt =>
                  let x := Script_int.abs (Script_int.of_int64 (Tez.to_mutez x))
                    in
                  let y := Script_int.abs (Script_int.of_int64 (Tez.to_mutez y))
                    in
                  consume_gas_binop descr
                    ((fun x =>
                      fun y =>
                        match Script_int.ediv_n x y with
                        | None => None
                        | Some (q, r) =>
                          match Script_int.to_int64 r with
                          | None =>
                            (* ❌ Assert instruction is not handled. *)
                            assert false
                          | Some r =>
                            match Tez.of_mutez r with
                            | None =>
                              (* ❌ Assert instruction is not handled. *)
                              assert false
                            | Some r => Some (q, r)
                            end
                          end
                        end), x, y) Interp_costs.div rest ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_intint,
            Item x (Item y rest)) =>
          consume_gas_binop descr (Script_int.ediv, x, y) Interp_costs.div rest
            ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_intnat,
            Item x (Item y rest)) =>
          consume_gas_binop descr (Script_int.ediv, x, y) Interp_costs.div rest
            ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_natint,
            Item x (Item y rest)) =>
          consume_gas_binop descr (Script_int.ediv, x, y) Interp_costs.div rest
            ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_natnat,
            Item x (Item y rest)) =>
          consume_gas_binop descr (Script_int.ediv_n, x, y) Interp_costs.div
            rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Lsl_nat,
            Item x (Item y rest)) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.shift_left x y)))
            (fun ctxt =>
              match Script_int.shift_left_n x y with
              | None =>
                fail
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Overflow
                    loc (get_log log))
              | Some x => logged_return ((Item x rest), ctxt)
              end)
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Lsr_nat,
            Item x (Item y rest)) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.shift_right x y)))
            (fun ctxt =>
              match Script_int.shift_right_n x y with
              | None =>
                fail
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Overflow
                    loc (get_log log))
              | Some r => logged_return ((Item r rest), ctxt)
              end)
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Or_nat, Item x (Item y rest))
          =>
          consume_gas_binop descr (Script_int.logor, x, y) Interp_costs.logor
            rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.And_nat,
            Item x (Item y rest)) =>
          consume_gas_binop descr (Script_int.logand, x, y) Interp_costs.logand
            rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.And_int_nat,
            Item x (Item y rest)) =>
          consume_gas_binop descr (Script_int.logand, x, y) Interp_costs.logand
            rest ctxt
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Xor_nat,
            Item x (Item y rest)) =>
          consume_gas_binop descr (Script_int.logxor, x, y) Interp_costs.logxor
            rest ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Not_int, Item x rest) =>
          consume_gas_unop descr (Script_int.lognot, x) Interp_costs.lognot rest
            ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Not_nat, Item x rest) =>
          consume_gas_unop descr (Script_int.lognot, x) Interp_costs.lognot rest
            ctxt
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Seq hd tl, stack) =>
          op_gtgteqquestion (step log ctxt step_constants hd stack)
            (fun function_parameter =>
              let '(trans, ctxt) := function_parameter in
              step log ctxt step_constants tl trans)
        | (Tezos_raw_protocol_alpha.Script_typed_ir.If bt _, Item true rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.branch))
            (fun ctxt => step log ctxt step_constants bt rest)
        | (Tezos_raw_protocol_alpha.Script_typed_ir.If _ bf, Item false rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.branch))
            (fun ctxt => step log ctxt step_constants bf rest)
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Loop body, Item true rest)
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.loop_cycle))
            (fun ctxt =>
              op_gtgteqquestion (step log ctxt step_constants body rest)
                (fun function_parameter =>
                  let '(trans, ctxt) := function_parameter in
                  step log ctxt step_constants descr trans))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Loop _, Item false rest) =>
          logged_return (rest, ctxt)
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Loop_left body,
            Item (Tezos_raw_protocol_alpha.Script_typed_ir.L v) rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.loop_cycle))
            (fun ctxt =>
              op_gtgteqquestion
                (step log ctxt step_constants body (Item v rest))
                (fun function_parameter =>
                  let '(trans, ctxt) := function_parameter in
                  step log ctxt step_constants descr trans))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Loop_left _,
            Item (Tezos_raw_protocol_alpha.Script_typed_ir.R v) rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.loop_cycle))
            (fun ctxt => logged_return ((Item v rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Dip b, Item ign rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.stack_op))
            (fun ctxt =>
              op_gtgteqquestion (step log ctxt step_constants b rest)
                (fun function_parameter =>
                  let '(res, ctxt) := function_parameter in
                  logged_return ((Item ign res), ctxt)))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Exec,
            Item arg (Item lam rest)) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.exec))
            (fun ctxt =>
              op_gtgteqquestion (interp log ctxt step_constants lam arg)
                (fun function_parameter =>
                  let '(res, ctxt) := function_parameter in
                  logged_return ((Item res rest), ctxt)))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Apply capture_ty,
            Item capture (Item lam rest)) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.apply))
            (fun ctxt =>
              let 'Tezos_raw_protocol_alpha.Script_typed_ir.Lam descr expr :=
                lam in
              let
                'Tezos_raw_protocol_alpha.Script_typed_ir.Item_t full_arg_ty _ _ :=
                bef descr in
              op_gtgteqquestion
                (unparse_data ctxt
                  Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                  capture_ty capture)
                (fun function_parameter =>
                  let '(const_expr, ctxt) := function_parameter in
                  op_gtgteqquestion (unparse_ty ctxt capture_ty)
                    (fun function_parameter =>
                      let '(ty_expr, ctxt) := function_parameter in
                      match full_arg_ty with
                      |
                        Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                          (capture_ty, _, _) (arg_ty, _, _) _ _ =>
                        let arg_stack_ty :=
                          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t arg_ty
                            Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t
                            None in
                        let const_descr :=
                          {| loc := loc descr; bef := arg_stack_ty;
                            aft :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                capture_ty arg_stack_ty None;
                            instr :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.Const
                                capture |} in
                        let pair_descr :=
                          {| loc := loc descr;
                            bef :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                capture_ty arg_stack_ty None;
                            aft :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                full_arg_ty
                                Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t
                                None;
                            instr :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.Cons_pair
                            |} in
                        let seq_descr :=
                          {| loc := loc descr; bef := arg_stack_ty;
                            aft :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                full_arg_ty
                                Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t
                                None;
                            instr :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.Seq
                                const_descr pair_descr |} in
                        let full_descr :=
                          {| loc := loc descr; bef := arg_stack_ty;
                            aft := aft descr;
                            instr :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.Seq
                                seq_descr descr |} in
                        let full_expr :=
                          Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                            0
                            (cons
                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                0
                                Tezos_raw_protocol_alpha.Alpha_context.Script.I_PUSH
                                (cons ty_expr (cons const_expr [])) [])
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0
                                  Tezos_raw_protocol_alpha.Alpha_context.Script.I_PAIR
                                  [] []) (cons expr []))) in
                        let lam' :=
                          Tezos_raw_protocol_alpha.Script_typed_ir.Lam
                            full_descr full_expr in
                        logged_return ((Item lam' rest), ctxt)
                      | _ =>
                        (* ❌ Assert instruction is not handled. *)
                        assert false
                      end)))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda lam, rest) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.push))
            (fun ctxt => logged_return ((Item lam rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Failwith tv, Item v _) =>
          op_gtgteqquestion
            (trace
              Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_failure
              (unparse_data ctxt
                Tezos_raw_protocol_alpha.Script_ir_translator.Optimized tv v))
            (fun function_parameter =>
              let '(v, _ctxt) := function_parameter in
              let v := Micheline.strip_locations v in
              fail
                (Tezos_protocol_environment_alpha__Environment.Error_monad.Reject
                  loc v (get_log log)))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Nop, stack) =>
          logged_return (stack, ctxt)
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Compare ty,
            Item a (Item b rest)) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.compare ty a b)))
            (fun ctxt =>
              logged_return
                ((Item
                  (op_atat Script_int.of_int
                    (Script_ir_translator.compare_comparable ty a b)) rest),
                  ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Eq, Item cmpres rest) =>
          let cmpres := Script_int.compare cmpres Script_int.zero in
          let cmpres :=
            Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
              cmpres 0 in
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.compare_res))
            (fun ctxt => logged_return ((Item cmpres rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Neq, Item cmpres rest) =>
          let cmpres := Script_int.compare cmpres Script_int.zero in
          let cmpres :=
            Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_ltgt)
              cmpres 0 in
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.compare_res))
            (fun ctxt => logged_return ((Item cmpres rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Lt, Item cmpres rest) =>
          let cmpres := Script_int.compare cmpres Script_int.zero in
          let cmpres :=
            Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
              cmpres 0 in
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.compare_res))
            (fun ctxt => logged_return ((Item cmpres rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Le, Item cmpres rest) =>
          let cmpres := Script_int.compare cmpres Script_int.zero in
          let cmpres :=
            Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lteq)
              cmpres 0 in
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.compare_res))
            (fun ctxt => logged_return ((Item cmpres rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Gt, Item cmpres rest) =>
          let cmpres := Script_int.compare cmpres Script_int.zero in
          let cmpres :=
            Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
              cmpres 0 in
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.compare_res))
            (fun ctxt => logged_return ((Item cmpres rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Ge, Item cmpres rest) =>
          let cmpres := Script_int.compare cmpres Script_int.zero in
          let cmpres :=
            Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
              cmpres 0 in
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.compare_res))
            (fun ctxt => logged_return ((Item cmpres rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Pack t, Item value rest) =>
          op_gtgteqquestion (Script_ir_translator.pack_data ctxt t value)
            (fun function_parameter =>
              let '(bytes, ctxt) := function_parameter in
              logged_return ((Item string rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Unpack t, Item bytes rest)
          =>
          op_gtgteqquestion
            (Lwt.__return
              (Gas.check_enough ctxt (Script.serialized_cost string)))
            (fun function_parameter =>
              let 'tt := function_parameter in
              if
                op_andand
                  (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
                    (MBytes.length string) 1)
                  (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
                    (MBytes.get_uint8 string 0) 5) then
                let bytes :=
                  MBytes.sub string 1 (op_minus (MBytes.length string) 1) in
                match Data_encoding.Binary.of_bytes Script.expr_encoding string
                  with
                | None =>
                  op_gtgteqquestion
                    (Lwt.__return
                      (Gas.consume ctxt (Interp_costs.unpack_failed string)))
                    (fun ctxt => logged_return ((Item None rest), ctxt))
                | Some expr =>
                  op_gtgteqquestion
                    (Lwt.__return
                      (Gas.consume ctxt (Script.deserialized_cost expr)))
                    (fun ctxt =>
                      op_gtgteq
                        (parse_data None ctxt false t (Micheline.root expr))
                        (fun function_parameter =>
                          match function_parameter with
                          |
                            Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                              (value, ctxt) =>
                            logged_return ((Item (Some value) rest), ctxt)
                          |
                            Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                              _ignored =>
                            op_gtgteqquestion
                              (Lwt.__return
                                (Gas.consume ctxt
                                  (Interp_costs.unpack_failed string)))
                              (fun ctxt =>
                                logged_return ((Item None rest), ctxt))
                          end))
                end
              else
                logged_return ((Item None rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Address,
            Item (_, address) rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.address))
            (fun ctxt => logged_return ((Item address rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Contract t entrypoint,
            Item contract rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.contract))
            (fun ctxt =>
              match (contract, entrypoint) with
              |
                ((contract, "default" % string), entrypoint) |
                  ((contract, entrypoint), "default" % string) =>
                op_gtgteqquestion
                  (Script_ir_translator.parse_contract_for_script false ctxt loc
                    t contract entrypoint)
                  (fun function_parameter =>
                    let '(ctxt, maybe_contract) := function_parameter in
                    logged_return ((Item maybe_contract rest), ctxt))
              | _ => logged_return ((Item None rest), ctxt)
              end)
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Transfer_tokens,
            Item p (Item amount (Item (tp, (destination, entrypoint)) rest))) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.transfer))
            (fun ctxt =>
              op_gtgteqquestion (collect_big_maps ctxt tp p)
                (fun function_parameter =>
                  let '(to_duplicate, ctxt) := function_parameter in
                  let to_update := no_big_map_id in
                  op_gtgteqquestion
                    (extract_big_map_diff ctxt
                      Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                      true to_duplicate to_update tp p)
                    (fun function_parameter =>
                      let '(p, big_map_diff, ctxt) := function_parameter in
                      op_gtgteqquestion
                        (unparse_data ctxt
                          Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                          tp p)
                        (fun function_parameter =>
                          let '(p, ctxt) := function_parameter in
                          let operation :=
                            Tezos_raw_protocol_alpha.Alpha_context.Transaction
                              {| amount := amount;
                                parameters :=
                                  Script.lazy_expr (Micheline.strip_locations p);
                                entrypoint := entrypoint;
                                destination := destination |} in
                          op_gtgteqquestion
                            (Lwt.__return (fresh_internal_nonce ctxt))
                            (fun function_parameter =>
                              let '(ctxt, nonce) := function_parameter in
                              logged_return
                                ((Item
                                  ((Tezos_raw_protocol_alpha.Alpha_context.Internal_operation
                                    {| source := self step_constants;
                                      operation := operation; nonce := nonce |}),
                                    big_map_diff) rest), ctxt))))))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Create_account,
            Item manager (Item delegate (Item _delegatable (Item credit rest))))
          =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.create_account))
            (fun ctxt =>
              op_gtgteqquestion
                (Contract.fresh_contract_from_current_nonce ctxt)
                (fun function_parameter =>
                  let '(ctxt, contract) := function_parameter in
                  let manager_bytes :=
                    Data_encoding.Binary.to_bytes_exn
                      Signature.Public_key_hash.encoding manager in
                  let storage :=
                    op_atat Script_repr.lazy_expr
                      (op_atat Micheline.strip_locations
                        (Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                          0 manager_bytes)) in
                  let script :=
                    {| code := Legacy_support.manager_script_code;
                      storage := storage |} in
                  let operation :=
                    Tezos_raw_protocol_alpha.Alpha_context.Origination
                      {| delegate := delegate; script := script;
                        credit := credit; preorigination := Some contract |} in
                  op_gtgteqquestion (Lwt.__return (fresh_internal_nonce ctxt))
                    (fun function_parameter =>
                      let '(ctxt, nonce) := function_parameter in
                      logged_return
                        ((Item
                          ((Tezos_raw_protocol_alpha.Alpha_context.Internal_operation
                            {| source := self step_constants;
                              operation := operation; nonce := nonce |}), None)
                          (Item (contract, "default" % string) rest)), ctxt))))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Implicit_account,
            Item key rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.implicit_account))
            (fun ctxt =>
              let contract := Contract.implicit_contract key in
              logged_return
                ((Item
                  ((Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t None),
                    (contract, "default" % string)) rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Create_contract storage_type
            param_type (Tezos_raw_protocol_alpha.Script_typed_ir.Lam _ code)
            root_name,
            Item manager
              (Item delegate
                (Item spendable
                  (Item delegatable (Item credit (Item init rest)))))) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.create_contract))
            (fun ctxt =>
              op_gtgteqquestion (unparse_ty ctxt param_type)
                (fun function_parameter =>
                  let '(unparsed_param_type, ctxt) := function_parameter in
                  let unparsed_param_type :=
                    Script_ir_translator.add_field_annot
                      (Option.map
                        (fun n =>
                          (* ❌ Variants not supported *)
                          variant) root_name) None unparsed_param_type in
                  op_gtgteqquestion (unparse_ty ctxt storage_type)
                    (fun function_parameter =>
                      let '(unparsed_storage_type, ctxt) := function_parameter
                        in
                      let code :=
                        op_atat Script.lazy_expr
                          (Micheline.strip_locations
                            (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                              0
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0
                                  Tezos_raw_protocol_alpha.Alpha_context.Script.K_parameter
                                  (cons unparsed_param_type []) [])
                                (cons
                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                    0
                                    Tezos_raw_protocol_alpha.Alpha_context.Script.K_storage
                                    (cons unparsed_storage_type []) [])
                                  (cons
                                    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                      0
                                      Tezos_raw_protocol_alpha.Alpha_context.Script.K_code
                                      (cons code []) []) []))))) in
                      op_gtgteqquestion
                        (collect_big_maps ctxt storage_type init)
                        (fun function_parameter =>
                          let '(to_duplicate, ctxt) := function_parameter in
                          let to_update := no_big_map_id in
                          op_gtgteqquestion
                            (extract_big_map_diff ctxt
                              Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                              true to_duplicate to_update storage_type init)
                            (fun function_parameter =>
                              let '(init, big_map_diff, ctxt) :=
                                function_parameter in
                              op_gtgteqquestion
                                (unparse_data ctxt
                                  Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                                  storage_type init)
                                (fun function_parameter =>
                                  let '(storage, ctxt) := function_parameter in
                                  let storage :=
                                    op_atat Script.lazy_expr
                                      (Micheline.strip_locations storage) in
                                  op_gtgteqquestion
                                    (if spendable then
                                      Legacy_support.add_do manager code storage
                                    else
                                      if delegatable then
                                        Legacy_support.add_set_delegate manager
                                          code storage
                                      else
                                        if
                                          Legacy_support.has_default_entrypoint
                                            code then
                                          op_gtgteqquestion
                                            (Legacy_support.add_root_entrypoint
                                              code)
                                            (fun code =>
                                              __return (code, storage))
                                        else
                                          __return (code, storage))
                                    (fun function_parameter =>
                                      let '(code, storage) := function_parameter
                                        in
                                      op_gtgteqquestion
                                        (Contract.fresh_contract_from_current_nonce
                                          ctxt)
                                        (fun function_parameter =>
                                          let '(ctxt, contract) :=
                                            function_parameter in
                                          let operation :=
                                            Tezos_raw_protocol_alpha.Alpha_context.Origination
                                              {| delegate := delegate;
                                                script :=
                                                  {| code := code;
                                                    storage := storage |};
                                                credit := credit;
                                                preorigination := Some contract
                                                |} in
                                          op_gtgteqquestion
                                            (Lwt.__return
                                              (fresh_internal_nonce ctxt))
                                            (fun function_parameter =>
                                              let '(ctxt, nonce) :=
                                                function_parameter in
                                              logged_return
                                                ((Item
                                                  ((Tezos_raw_protocol_alpha.Alpha_context.Internal_operation
                                                    {|
                                                      source :=
                                                        self step_constants;
                                                      operation := operation;
                                                      nonce := nonce |}),
                                                    big_map_diff)
                                                  (Item
                                                    (contract,
                                                      "default" % string) rest)),
                                                  ctxt))))))))))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Create_contract_2
            storage_type param_type
            (Tezos_raw_protocol_alpha.Script_typed_ir.Lam _ code) root_name,
            Item delegate (Item credit (Item init rest))) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.create_contract))
            (fun ctxt =>
              op_gtgteqquestion (unparse_ty ctxt param_type)
                (fun function_parameter =>
                  let '(unparsed_param_type, ctxt) := function_parameter in
                  let unparsed_param_type :=
                    Script_ir_translator.add_field_annot
                      (Option.map
                        (fun n =>
                          (* ❌ Variants not supported *)
                          variant) root_name) None unparsed_param_type in
                  op_gtgteqquestion (unparse_ty ctxt storage_type)
                    (fun function_parameter =>
                      let '(unparsed_storage_type, ctxt) := function_parameter
                        in
                      let code :=
                        Micheline.strip_locations
                          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                            0
                            (cons
                              (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                0
                                Tezos_raw_protocol_alpha.Alpha_context.Script.K_parameter
                                (cons unparsed_param_type []) [])
                              (cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  0
                                  Tezos_raw_protocol_alpha.Alpha_context.Script.K_storage
                                  (cons unparsed_storage_type []) [])
                                (cons
                                  (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                    0
                                    Tezos_raw_protocol_alpha.Alpha_context.Script.K_code
                                    (cons code []) []) [])))) in
                      op_gtgteqquestion
                        (collect_big_maps ctxt storage_type init)
                        (fun function_parameter =>
                          let '(to_duplicate, ctxt) := function_parameter in
                          let to_update := no_big_map_id in
                          op_gtgteqquestion
                            (extract_big_map_diff ctxt
                              Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                              true to_duplicate to_update storage_type init)
                            (fun function_parameter =>
                              let '(init, big_map_diff, ctxt) :=
                                function_parameter in
                              op_gtgteqquestion
                                (unparse_data ctxt
                                  Tezos_raw_protocol_alpha.Script_ir_translator.Optimized
                                  storage_type init)
                                (fun function_parameter =>
                                  let '(storage, ctxt) := function_parameter in
                                  let storage :=
                                    Micheline.strip_locations storage in
                                  op_gtgteqquestion
                                    (Contract.fresh_contract_from_current_nonce
                                      ctxt)
                                    (fun function_parameter =>
                                      let '(ctxt, contract) :=
                                        function_parameter in
                                      let operation :=
                                        Tezos_raw_protocol_alpha.Alpha_context.Origination
                                          {| delegate := delegate;
                                            script :=
                                              {| code := Script.lazy_expr code;
                                                storage :=
                                                  Script.lazy_expr storage |};
                                            credit := credit;
                                            preorigination := Some contract |}
                                        in
                                      op_gtgteqquestion
                                        (Lwt.__return
                                          (fresh_internal_nonce ctxt))
                                        (fun function_parameter =>
                                          let '(ctxt, nonce) :=
                                            function_parameter in
                                          logged_return
                                            ((Item
                                              ((Tezos_raw_protocol_alpha.Alpha_context.Internal_operation
                                                {|
                                                  source := self step_constants;
                                                  operation := operation;
                                                  nonce := nonce |}),
                                                big_map_diff)
                                              (Item
                                                (contract, "default" % string)
                                                rest)), ctxt)))))))))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Set_delegate,
            Item delegate rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.create_account))
            (fun ctxt =>
              let operation :=
                Tezos_raw_protocol_alpha.Alpha_context.Delegation delegate in
              op_gtgteqquestion (Lwt.__return (fresh_internal_nonce ctxt))
                (fun function_parameter =>
                  let '(ctxt, nonce) := function_parameter in
                  logged_return
                    ((Item
                      ((Tezos_raw_protocol_alpha.Alpha_context.Internal_operation
                        {| source := self step_constants;
                          operation := operation; nonce := nonce |}), None) rest),
                      ctxt)))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Balance, rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.balance))
            (fun ctxt =>
              op_gtgteqquestion
                (Contract.get_balance ctxt (self step_constants))
                (fun balance => logged_return ((Item balance rest), ctxt)))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Now, rest) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.now))
            (fun ctxt =>
              let now := Script_timestamp.now ctxt in
              logged_return ((Item now rest), ctxt))
        |
          (Tezos_raw_protocol_alpha.Script_typed_ir.Check_signature,
            Item key (Item signature (Item message rest))) =>
          op_gtgteqquestion
            (Lwt.__return
              (Gas.consume ctxt (Interp_costs.check_signature key message)))
            (fun ctxt =>
              let res := Signature.check None key signature message in
              logged_return ((Item res rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Hash_key, Item key rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.hash_key))
            (fun ctxt =>
              logged_return ((Item (Signature.Public_key.hash key) rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Blake2b, Item bytes rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.hash_blake2b string)))
            (fun ctxt =>
              let hash := Raw_hashes.blake2b string in
              logged_return ((Item hash rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Sha256, Item bytes rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.hash_sha256 string)))
            (fun ctxt =>
              let hash := Raw_hashes.sha256 string in
              logged_return ((Item hash rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Sha512, Item bytes rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.hash_sha512 string)))
            (fun ctxt =>
              let hash := Raw_hashes.sha512 string in
              logged_return ((Item hash rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Steps_to_quota, rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.steps_to_quota))
            (fun ctxt =>
              let steps :=
                match Gas.level ctxt with
                |
                  Tezos_raw_protocol_alpha.Alpha_context.Gas.Limited {|
                    remaining := remaining |} => remaining
                | Tezos_raw_protocol_alpha.Alpha_context.Gas.Unaccounted =>
                  Z.of_string "99999999" % string
                end in
              logged_return ((Item (abs (of_zint steps)) rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Source, rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.source))
            (fun ctxt =>
              logged_return
                ((Item ((payer step_constants), "default" % string) rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Sender, rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.source))
            (fun ctxt =>
              logged_return
                ((Item ((source step_constants), "default" % string) rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Self t entrypoint, rest) =>
          op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Interp_costs.self))
            (fun ctxt =>
              logged_return
                ((Item (t, ((self step_constants), entrypoint)) rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Amount, rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.amount))
            (fun ctxt =>
              logged_return ((Item (amount step_constants) rest), ctxt))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Dig n n', stack) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.stack_n_op n)))
            (fun ctxt =>
              op_gtgteqquestion
                (interp_stack_prefix_preserving_operation
                  (fun function_parameter =>
                    let 'Item v rest := function_parameter in
                    __return (rest, v)) n' stack)
                (fun function_parameter =>
                  let '(aft, x) := function_parameter in
                  logged_return ((Item x aft), ctxt)))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Dug n n', Item v rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.stack_n_op n)))
            (fun ctxt =>
              op_gtgteqquestion
                (interp_stack_prefix_preserving_operation
                  (fun stk => __return ((Item v stk), tt)) n' rest)
                (fun function_parameter =>
                  let '(aft, tt) := function_parameter in
                  logged_return (aft, ctxt)))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Dipn n n' b, stack) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.stack_n_op n)))
            (fun ctxt =>
              op_gtgteqquestion
                (interp_stack_prefix_preserving_operation
                  (fun stk =>
                    op_gtgteqquestion (step log ctxt step_constants b stk)
                      (fun function_parameter =>
                        let '(res, ctxt') := function_parameter in
                        __return (res, ctxt'))) n' stack)
                (fun function_parameter =>
                  let '(aft, ctxt') := function_parameter in
                  logged_return (aft, ctxt')))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.Dropn n n', stack) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Interp_costs.stack_n_op n)))
            (fun ctxt =>
              op_gtgteqquestion
                (interp_stack_prefix_preserving_operation
                  (fun stk => __return (stk, stk)) n' stack)
                (fun function_parameter =>
                  let '(_, rest) := function_parameter in
                  logged_return (rest, ctxt)))
        | (Tezos_raw_protocol_alpha.Script_typed_ir.ChainId, rest) =>
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt Interp_costs.chain_id))
            (fun ctxt =>
              logged_return ((Item (chain_id step_constants) rest), ctxt))
        end)

with interp {p r : Type}
  (log :
    option
      (Tezos_protocol_environment_alpha__Environment.Pervasives.ref
        execution_trace))
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (step_constants : step_constants)
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.lambda p r)
  : p ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (r * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let 'Tezos_raw_protocol_alpha.Script_typed_ir.Lam code _ := function_parameter
    in
  fun arg =>
    let stack := Item arg Empty in
    op_gtgteqquestion
      match log with
      | None => return_unit
      | Some log =>
        op_gtgteqquestion
          (trace
            Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_log
            (unparse_stack ctxt (stack, (bef code))))
          (fun stack =>
            (* ❌ Sequences of instructions are not handled (operator ";") *)
            let _ :=
              op_coloneq log
                (cons ((loc code), (Gas.level ctxt), stack) (op_exclamation log))
              in
            return_unit)
      end
      (fun function_parameter =>
        let 'tt := function_parameter in
        op_gtgteqquestion (step log ctxt step_constants code stack)
          (fun function_parameter =>
            let '(Item ret Empty, ctxt) := function_parameter in
            __return (ret, ctxt)))

with execute
  (log :
    option
      (Tezos_protocol_environment_alpha__Environment.Pervasives.ref
        execution_trace))
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
  (step_constants : step_constants) (entrypoint : string)
  (unparsed_script : Tezos_raw_protocol_alpha.Alpha_context.Script.t)
  (arg : Tezos_raw_protocol_alpha.Alpha_context.Script.node)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
        list Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation *
        Tezos_raw_protocol_alpha.Alpha_context.context *
        option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff)) :=
  op_gtgteqquestion (parse_script None ctxt true unparsed_script)
    (fun function_parameter =>
      let
        '(Tezos_raw_protocol_alpha.Script_ir_translator.Ex_script {|
          code := code;
            arg_type := arg_type;
            storage := storage;
            storage_type := storage_type;
            root_name := root_name
            |}, ctxt) := function_parameter in
      op_gtgteqquestion
        (trace
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_contract_parameter
            (self step_constants))
          (Lwt.__return (find_entrypoint arg_type root_name entrypoint)))
        (fun function_parameter =>
          let '(box, _) := function_parameter in
          op_gtgteqquestion
            (trace
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_contract_parameter
                (self step_constants))
              (parse_data None ctxt false arg_type (box arg)))
            (fun function_parameter =>
              let '(arg, ctxt) := function_parameter in
              op_gtgteqquestion
                (Script.force_decode ctxt (code unparsed_script))
                (fun function_parameter =>
                  let '(script_code, ctxt) := function_parameter in
                  op_gtgteqquestion
                    (Script_ir_translator.collect_big_maps ctxt arg_type arg)
                    (fun function_parameter =>
                      let '(to_duplicate, ctxt) := function_parameter in
                      op_gtgteqquestion
                        (Script_ir_translator.collect_big_maps ctxt storage_type
                          storage)
                        (fun function_parameter =>
                          let '(to_update, ctxt) := function_parameter in
                          op_gtgteqquestion
                            (trace
                              (Tezos_protocol_environment_alpha__Environment.Error_monad.Runtime_contract_error
                                (self step_constants) script_code)
                              (interp log ctxt step_constants code
                                (arg, storage)))
                            (fun function_parameter =>
                              let '((ops, storage), ctxt) := function_parameter
                                in
                              op_gtgteqquestion
                                (Script_ir_translator.extract_big_map_diff ctxt
                                  mode false to_duplicate to_update storage_type
                                  storage)
                                (fun function_parameter =>
                                  let '(storage, big_map_diff, ctxt) :=
                                    function_parameter in
                                  op_gtgteqquestion
                                    (trace
                                      Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_storage
                                      (unparse_data ctxt mode storage_type
                                        storage))
                                    (fun function_parameter =>
                                      let '(storage, ctxt) := function_parameter
                                        in
                                      let '(ops, op_diffs) := List.split ops in
                                      let big_map_diff :=
                                        match
                                          List.flatten
                                            (List.map (Option.unopt [])
                                              (op_at op_diffs
                                                (cons big_map_diff []))) with
                                        | [] => None
                                        | diff => Some diff
                                        end in
                                      __return
                                        ((Micheline.strip_locations storage),
                                          ops, ctxt, big_map_diff)))))))))).

Record execution_result := {
  ctxt : Tezos_raw_protocol_alpha.Alpha_context.context;
  storage : Tezos_raw_protocol_alpha.Alpha_context.Script.expr;
  big_map_diff :
    option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff;
  operations :
    list Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation }.

Definition trace
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
  (step_constants : step_constants)
  (script : Tezos_raw_protocol_alpha.Alpha_context.Script.t)
  (entrypoint : string)
  (parameter :
    Tezos_protocol_environment_alpha__Environment.Micheline.canonical
      Tezos_raw_protocol_alpha.Alpha_context.Script.prim)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (execution_result *
        list
          (Tezos_raw_protocol_alpha.Alpha_context.Script.location *
            Tezos_raw_protocol_alpha.Alpha_context.Gas.t *
            list
              (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
                option string)))) :=
  let log := ref [] in
  op_gtgteqquestion
    (execute (Some log) ctxt mode step_constants entrypoint script
      (Micheline.root parameter))
    (fun function_parameter =>
      let '(storage, operations, ctxt, big_map_diff) := function_parameter in
      let trace := List.rev (op_exclamation log) in
      __return
        ({| ctxt := ctxt; storage := storage; big_map_diff := big_map_diff;
          operations := operations |}, trace)).

Definition execute
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (mode : Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode)
  (step_constants : step_constants)
  (script : Tezos_raw_protocol_alpha.Alpha_context.Script.t)
  (entrypoint : string)
  (parameter :
    Tezos_protocol_environment_alpha__Environment.Micheline.canonical
      Tezos_raw_protocol_alpha.Alpha_context.Script.prim)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      execution_result) :=
  op_gtgteqquestion
    (execute None ctxt mode step_constants entrypoint script
      (Micheline.root parameter))
    (fun function_parameter =>
      let '(storage, operations, ctxt, big_map_diff) := function_parameter in
      __return
        {| ctxt := ctxt; storage := storage; big_map_diff := big_map_diff;
          operations := operations |}).
script_interpreter.mli 9 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

type execution_trace =
  (Script.location * Gas.t * (Script.expr * string option) list) list

type error +=
  | Reject of Script.location * Script.expr * execution_trace option

type error += Overflow of Script.location * execution_trace option

type error += Runtime_contract_error : Contract.t * Script.expr -> error

type error += Bad_contract_parameter of Contract.t (* `Permanent *)

type error += Cannot_serialize_log

type error += Cannot_serialize_failure

type error += Cannot_serialize_storage

type execution_result = {
  ctxt : context;
  storage : Script.expr;
  big_map_diff : Contract.big_map_diff option;
  operations : packed_internal_operation list;
}

type step_constants = {
  source : Contract.t;
  payer : Contract.t;
  self : Contract.t;
  amount : Tez.t;
  chain_id : Chain_id.t;
}

type 'tys stack =
  | Item : 'ty * 'rest stack -> ('ty * 'rest) stack
  | Empty : Script_typed_ir.end_of_stack stack

val step :
  ?log:execution_trace ref ->
  context ->
  step_constants ->
  ('bef, 'aft) Script_typed_ir.descr ->
  'bef stack ->
  ('aft stack * context) tzresult Lwt.t

val execute :
  Alpha_context.t ->
  Script_ir_translator.unparsing_mode ->
  step_constants ->
  script:Script.t ->
  entrypoint:string ->
  parameter:Script.expr ->
  execution_result tzresult Lwt.t

val trace :
  Alpha_context.t ->
  Script_ir_translator.unparsing_mode ->
  step_constants ->
  script:Script.t ->
  entrypoint:string ->
  parameter:Script.expr ->
  (execution_result * execution_trace) tzresult Lwt.t
script_interpreter_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition execution_trace :=
  list
    (Tezos_raw_protocol_alpha.Alpha_context.Script.location *
      Tezos_raw_protocol_alpha.Alpha_context.Gas.t *
      list (Tezos_raw_protocol_alpha.Alpha_context.Script.expr * option string)).

extensible_type

extensible_type

extensible_type

extensible_type

extensible_type

extensible_type

extensible_type

Record execution_result := {
  ctxt : Tezos_raw_protocol_alpha.Alpha_context.context;
  storage : Tezos_raw_protocol_alpha.Alpha_context.Script.expr;
  big_map_diff :
    option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff;
  operations :
    list Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation }.

Record step_constants := {
  source : Tezos_raw_protocol_alpha.Alpha_context.Contract.t;
  payer : Tezos_raw_protocol_alpha.Alpha_context.Contract.t;
  self : Tezos_raw_protocol_alpha.Alpha_context.Contract.t;
  amount : Tezos_raw_protocol_alpha.Alpha_context.Tez.t;
  chain_id :
    Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
  }.

Reserved Notation "'stack".

Inductive stack_gadt : Type :=
| Item : forall {ty : Type}, ty -> stack_gadt -> stack_gadt
| Empty : stack_gadt

where "'stack" := (fun (tys : Type) => stack_gadt).

Definition stack := 'stack.

Parameter step : forall {aft bef : Type},
option
  (Tezos_protocol_environment_alpha__Environment.Pervasives.ref execution_trace)
  ->
  Tezos_raw_protocol_alpha.Alpha_context.context ->
    step_constants ->
      Tezos_raw_protocol_alpha.Script_typed_ir.descr bef aft ->
        stack bef ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (stack aft * Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter execute :
Tezos_raw_protocol_alpha.Alpha_context.t ->
  Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode ->
    step_constants ->
      Tezos_raw_protocol_alpha.Alpha_context.Script.t ->
        string ->
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                execution_result).

Parameter trace :
Tezos_raw_protocol_alpha.Alpha_context.t ->
  Tezos_raw_protocol_alpha.Script_ir_translator.unparsing_mode ->
    step_constants ->
      Tezos_raw_protocol_alpha.Alpha_context.Script.t ->
        string ->
          Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                (execution_result * execution_trace)).
script_ir_annot.ml 138 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Micheline
open Script_tc_errors
open Script_typed_ir

let default_now_annot = Some (`Var_annot "now")

let default_amount_annot = Some (`Var_annot "amount")

let default_balance_annot = Some (`Var_annot "balance")

let default_steps_annot = Some (`Var_annot "steps")

let default_source_annot = Some (`Var_annot "source")

let default_sender_annot = Some (`Var_annot "sender")

let default_self_annot = Some (`Var_annot "self")

let default_arg_annot = Some (`Var_annot "arg")

let default_param_annot = Some (`Var_annot "parameter")

let default_storage_annot = Some (`Var_annot "storage")

let default_car_annot = Some (`Field_annot "car")

let default_cdr_annot = Some (`Field_annot "cdr")

let default_contract_annot = Some (`Field_annot "contract")

let default_addr_annot = Some (`Field_annot "address")

let default_manager_annot = Some (`Field_annot "manager")

let default_pack_annot = Some (`Field_annot "packed")

let default_unpack_annot = Some (`Field_annot "unpacked")

let default_slice_annot = Some (`Field_annot "slice")

let default_elt_annot = Some (`Field_annot "elt")

let default_key_annot = Some (`Field_annot "key")

let default_hd_annot = Some (`Field_annot "hd")

let default_tl_annot = Some (`Field_annot "tl")

let default_some_annot = Some (`Field_annot "some")

let default_left_annot = Some (`Field_annot "left")

let default_right_annot = Some (`Field_annot "right")

let default_binding_annot = Some (`Field_annot "bnd")

let unparse_type_annot : type_annot option -> string list = function
  | None ->
      []
  | Some (`Type_annot a) ->
      [":" ^ a]

let unparse_var_annot : var_annot option -> string list = function
  | None ->
      []
  | Some (`Var_annot a) ->
      ["@" ^ a]

let unparse_field_annot : field_annot option -> string list = function
  | None ->
      []
  | Some (`Field_annot a) ->
      ["%" ^ a]

let field_to_var_annot : field_annot option -> var_annot option = function
  | None ->
      None
  | Some (`Field_annot s) ->
      Some (`Var_annot s)

let type_to_var_annot : type_annot option -> var_annot option = function
  | None ->
      None
  | Some (`Type_annot s) ->
      Some (`Var_annot s)

let var_to_field_annot : var_annot option -> field_annot option = function
  | None ->
      None
  | Some (`Var_annot s) ->
      Some (`Field_annot s)

let default_annot ~default = function None -> default | annot -> annot

let gen_access_annot :
    var_annot option ->
    ?default:field_annot option ->
    field_annot option ->
    var_annot option =
 fun value_annot ?(default = None) field_annot ->
  match (value_annot, field_annot, default) with
  | (None, None, _) | (Some _, None, None) | (None, Some (`Field_annot ""), _)
    ->
      None
  | (None, Some (`Field_annot f), _) ->
      Some (`Var_annot f)
  | ( Some (`Var_annot v),
      (None | Some (`Field_annot "")),
      Some (`Field_annot f) ) ->
      Some (`Var_annot (String.concat "." [v; f]))
  | (Some (`Var_annot v), Some (`Field_annot f), _) ->
      Some (`Var_annot (String.concat "." [v; f]))

let merge_type_annot :
    legacy:bool ->
    type_annot option ->
    type_annot option ->
    type_annot option tzresult =
 fun ~legacy annot1 annot2 ->
  match (annot1, annot2) with
  | (None, None) | (Some _, None) | (None, Some _) ->
      ok None
  | (Some (`Type_annot a1), Some (`Type_annot a2)) ->
      if legacy || String.equal a1 a2 then ok annot1
      else error (Inconsistent_annotations (":" ^ a1, ":" ^ a2))

let merge_field_annot :
    legacy:bool ->
    field_annot option ->
    field_annot option ->
    field_annot option tzresult =
 fun ~legacy annot1 annot2 ->
  match (annot1, annot2) with
  | (None, None) | (Some _, None) | (None, Some _) ->
      ok None
  | (Some (`Field_annot a1), Some (`Field_annot a2)) ->
      if legacy || String.equal a1 a2 then ok annot1
      else error (Inconsistent_annotations ("%" ^ a1, "%" ^ a2))

let merge_var_annot : var_annot option -> var_annot option -> var_annot option
    =
 fun annot1 annot2 ->
  match (annot1, annot2) with
  | (None, None) | (Some _, None) | (None, Some _) ->
      None
  | (Some (`Var_annot a1), Some (`Var_annot a2)) ->
      if String.equal a1 a2 then annot1 else None

let error_unexpected_annot loc annot =
  match annot with [] -> ok () | _ :: _ -> error (Unexpected_annotation loc)

let fail_unexpected_annot loc annot =
  Lwt.return (error_unexpected_annot loc annot)

let parse_annots loc ?(allow_special_var = false)
    ?(allow_special_field = false) l =
  (* allow emtpty annotations as wildcards but otherwise only accept
     annotations that start with [a-zA-Z_] *)
  let sub_or_wildcard ~specials wrap s acc =
    let len = String.length s in
    if Compare.Int.(len = 1) then ok @@ (wrap None :: acc)
    else
      match s.[1] with
      | 'a' .. 'z' | 'A' .. 'Z' | '_' ->
          ok @@ (wrap (Some (String.sub s 1 (len - 1))) :: acc)
      | '@' when Compare.Int.(len = 2) && List.mem '@' specials ->
          ok @@ (wrap (Some "@") :: acc)
      | '%' when List.mem '%' specials ->
          if Compare.Int.(len = 2) then ok @@ (wrap (Some "%") :: acc)
          else if Compare.Int.(len = 3) && Compare.Char.(s.[2] = '%') then
            ok @@ (wrap (Some "%%") :: acc)
          else error (Unexpected_annotation loc)
      | _ ->
          error (Unexpected_annotation loc)
  in
  List.fold_left
    (fun acc s ->
      acc
      >>? fun acc ->
      if Compare.Int.(String.length s = 0) then
        error (Unexpected_annotation loc)
      else
        match s.[0] with
        | ':' ->
            sub_or_wildcard ~specials:[] (fun a -> `Type_annot a) s acc
        | '@' ->
            sub_or_wildcard
              ~specials:(if allow_special_var then ['%'] else [])
              (fun a -> `Var_annot a)
              s
              acc
        | '%' ->
            sub_or_wildcard
              ~specials:(if allow_special_field then ['@'] else [])
              (fun a -> `Field_annot a)
              s
              acc
        | _ ->
            error (Unexpected_annotation loc))
    (ok [])
    l
  >|? List.rev

let opt_var_of_var_opt = function
  | `Var_annot None ->
      None
  | `Var_annot (Some a) ->
      Some (`Var_annot a)

let opt_field_of_field_opt = function
  | `Field_annot None ->
      None
  | `Field_annot (Some a) ->
      Some (`Field_annot a)

let opt_type_of_type_opt = function
  | `Type_annot None ->
      None
  | `Type_annot (Some a) ->
      Some (`Type_annot a)

let classify_annot loc l :
    (var_annot option list * type_annot option list * field_annot option list)
    tzresult =
  try
    let (_, rv, _, rt, _, rf) =
      List.fold_left
        (fun (in_v, rv, in_t, rt, in_f, rf) a ->
          match (a, in_v, rv, in_t, rt, in_f, rf) with
          | ((`Var_annot _ as a), true, _, _, _, _, _)
          | ((`Var_annot _ as a), false, [], _, _, _, _) ->
              (true, opt_var_of_var_opt a :: rv, false, rt, false, rf)
          | ((`Type_annot _ as a), _, _, true, _, _, _)
          | ((`Type_annot _ as a), _, _, false, [], _, _) ->
              (false, rv, true, opt_type_of_type_opt a :: rt, false, rf)
          | ((`Field_annot _ as a), _, _, _, _, true, _)
          | ((`Field_annot _ as a), _, _, _, _, false, []) ->
              (false, rv, false, rt, true, opt_field_of_field_opt a :: rf)
          | _ ->
              raise Exit)
        (false, [], false, [], false, [])
        l
    in
    ok (List.rev rv, List.rev rt, List.rev rf)
  with Exit -> error (Ungrouped_annotations loc)

let get_one_annot loc = function
  | [] ->
      ok None
  | [a] ->
      ok a
  | _ ->
      error (Unexpected_annotation loc)

let get_two_annot loc = function
  | [] ->
      ok (None, None)
  | [a] ->
      ok (a, None)
  | [a; b] ->
      ok (a, b)
  | _ ->
      error (Unexpected_annotation loc)

let parse_type_annot : int -> string list -> type_annot option tzresult =
 fun loc annot ->
  parse_annots loc annot >>? classify_annot loc
  >>? fun (vars, types, fields) ->
  error_unexpected_annot loc vars
  >>? fun () ->
  error_unexpected_annot loc fields >>? fun () -> get_one_annot loc types

let parse_type_field_annot :
    int -> string list -> (type_annot option * field_annot option) tzresult =
 fun loc annot ->
  parse_annots loc annot >>? classify_annot loc
  >>? fun (vars, types, fields) ->
  error_unexpected_annot loc vars
  >>? fun () ->
  get_one_annot loc types
  >>? fun t -> get_one_annot loc fields >|? fun f -> (t, f)

let parse_composed_type_annot :
    int ->
    string list ->
    (type_annot option * field_annot option * field_annot option) tzresult =
 fun loc annot ->
  parse_annots loc annot >>? classify_annot loc
  >>? fun (vars, types, fields) ->
  error_unexpected_annot loc vars
  >>? fun () ->
  get_one_annot loc types
  >>? fun t -> get_two_annot loc fields >|? fun (f1, f2) -> (t, f1, f2)

let parse_field_annot : int -> string list -> field_annot option tzresult =
 fun loc annot ->
  parse_annots loc annot >>? classify_annot loc
  >>? fun (vars, types, fields) ->
  error_unexpected_annot loc vars
  >>? fun () ->
  error_unexpected_annot loc types >>? fun () -> get_one_annot loc fields

let extract_field_annot :
    Script.node -> (Script.node * field_annot option) tzresult = function
  | Prim (loc, prim, args, annot) ->
      let rec extract_first acc = function
        | [] ->
            (None, annot)
        | s :: rest ->
            if Compare.Int.(String.length s > 0) && Compare.Char.(s.[0] = '%')
            then (Some s, List.rev_append acc rest)
            else extract_first (s :: acc) rest
      in
      let (field_annot, annot) = extract_first [] annot in
      let field_annot =
        match field_annot with
        | None ->
            None
        | Some field_annot ->
            Some
              (`Field_annot
                (String.sub field_annot 1 (String.length field_annot - 1)))
      in
      ok (Prim (loc, prim, args, annot), field_annot)
  | expr ->
      ok (expr, None)

let check_correct_field :
    field_annot option -> field_annot option -> unit tzresult =
 fun f1 f2 ->
  match (f1, f2) with
  | (None, _) | (_, None) ->
      ok ()
  | (Some (`Field_annot s1), Some (`Field_annot s2)) ->
      if String.equal s1 s2 then ok ()
      else error (Inconsistent_field_annotations ("%" ^ s1, "%" ^ s2))

let parse_var_annot :
    int ->
    ?default:var_annot option ->
    string list ->
    var_annot option tzresult =
 fun loc ?default annot ->
  parse_annots loc annot >>? classify_annot loc
  >>? fun (vars, types, fields) ->
  error_unexpected_annot loc types
  >>? fun () ->
  error_unexpected_annot loc fields
  >>? fun () ->
  get_one_annot loc vars
  >|? function
  | Some _ as a ->
      a
  | None -> (
    match default with Some a -> a | None -> None )

let split_last_dot = function
  | None ->
      (None, None)
  | Some (`Field_annot s) -> (
    match String.rindex_opt s '.' with
    | None ->
        (None, Some (`Field_annot s))
    | Some i ->
        let s1 = String.sub s 0 i in
        let s2 = String.sub s (i + 1) (String.length s - i - 1) in
        let f =
          if Compare.String.equal s2 "car" || Compare.String.equal s2 "cdr"
          then None
          else Some (`Field_annot s2)
        in
        (Some (`Var_annot s1), f) )

let common_prefix v1 v2 =
  match (v1, v2) with
  | (Some (`Var_annot s1), Some (`Var_annot s2))
    when Compare.String.equal s1 s2 ->
      v1
  | (Some _, None) ->
      v1
  | (None, Some _) ->
      v2
  | (_, _) ->
      None

let parse_constr_annot :
    int ->
    ?if_special_first:field_annot option ->
    ?if_special_second:field_annot option ->
    string list ->
    ( var_annot option
    * type_annot option
    * field_annot option
    * field_annot option )
    tzresult =
 fun loc ?if_special_first ?if_special_second annot ->
  parse_annots ~allow_special_field:true loc annot
  >>? classify_annot loc
  >>? fun (vars, types, fields) ->
  get_one_annot loc vars
  >>? fun v ->
  get_one_annot loc types
  >>? fun t ->
  get_two_annot loc fields
  >>? fun (f1, f2) ->
  ( match (if_special_first, f1) with
  | (Some special_var, Some (`Field_annot "@")) ->
      ok (split_last_dot special_var)
  | (None, Some (`Field_annot "@")) ->
      error (Unexpected_annotation loc)
  | (_, _) ->
      ok (v, f1) )
  >>? fun (v1, f1) ->
  ( match (if_special_second, f2) with
  | (Some special_var, Some (`Field_annot "@")) ->
      ok (split_last_dot special_var)
  | (None, Some (`Field_annot "@")) ->
      error (Unexpected_annotation loc)
  | (_, _) ->
      ok (v, f2) )
  >|? fun (v2, f2) ->
  let v = match v with None -> common_prefix v1 v2 | Some _ -> v in
  (v, t, f1, f2)

let parse_two_var_annot :
    int -> string list -> (var_annot option * var_annot option) tzresult =
 fun loc annot ->
  parse_annots loc annot >>? classify_annot loc
  >>? fun (vars, types, fields) ->
  error_unexpected_annot loc types
  >>? fun () ->
  error_unexpected_annot loc fields >>? fun () -> get_two_annot loc vars

let parse_destr_annot :
    int ->
    string list ->
    default_accessor:field_annot option ->
    field_name:field_annot option ->
    pair_annot:var_annot option ->
    value_annot:var_annot option ->
    (var_annot option * field_annot option) tzresult =
 fun loc annot ~default_accessor ~field_name ~pair_annot ~value_annot ->
  parse_annots loc ~allow_special_var:true annot
  >>? classify_annot loc
  >>? fun (vars, types, fields) ->
  error_unexpected_annot loc types
  >>? fun () ->
  get_one_annot loc vars
  >>? fun v ->
  get_one_annot loc fields
  >|? fun f ->
  let default =
    gen_access_annot pair_annot field_name ~default:default_accessor
  in
  let v =
    match v with
    | Some (`Var_annot "%") ->
        field_to_var_annot field_name
    | Some (`Var_annot "%%") ->
        default
    | Some _ ->
        v
    | None ->
        value_annot
  in
  (v, f)

let parse_entrypoint_annot :
    int ->
    ?default:var_annot option ->
    string list ->
    (var_annot option * field_annot option) tzresult =
 fun loc ?default annot ->
  parse_annots loc annot >>? classify_annot loc
  >>? fun (vars, types, fields) ->
  error_unexpected_annot loc types
  >>? fun () ->
  get_one_annot loc fields
  >>? fun f ->
  get_one_annot loc vars
  >|? function
  | Some _ as a ->
      (a, f)
  | None -> (
    match default with Some a -> (a, f) | None -> (None, f) )

let parse_var_type_annot :
    int -> string list -> (var_annot option * type_annot option) tzresult =
 fun loc annot ->
  parse_annots loc annot >>? classify_annot loc
  >>? fun (vars, types, fields) ->
  error_unexpected_annot loc fields
  >>? fun () ->
  get_one_annot loc vars
  >>? fun v -> get_one_annot loc types >|? fun t -> (v, t)
script_ir_annot_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Import Micheline.

Import Script_tc_errors.

Import Script_typed_ir.

Definition default_now_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_amount_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_balance_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_steps_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_source_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_sender_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_self_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_arg_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_param_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_storage_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_car_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_cdr_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_contract_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_addr_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_manager_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_pack_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_unpack_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_slice_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_elt_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_key_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_hd_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_tl_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_some_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_left_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_right_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition default_binding_annot : option variant :=
  Some
    (* ❌ Variants not supported *)
    variant.

Definition unparse_type_annot
  (function_parameter :
    option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot) : list string :=
  match function_parameter with
  | None => []
  | Some (Type_annot a) => cons (op_caret ":" % string a) []
  end.

Definition unparse_var_annot
  (function_parameter :
    option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot) : list string :=
  match function_parameter with
  | None => []
  | Some (Var_annot a) => cons (op_caret "@" % string a) []
  end.

Definition unparse_field_annot
  (function_parameter :
    option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  : list string :=
  match function_parameter with
  | None => []
  | Some (Field_annot a) => cons (op_caret "%" % string a) []
  end.

Definition field_to_var_annot
  (function_parameter :
    option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot :=
  match function_parameter with
  | None => None
  | Some (Field_annot s) =>
    Some
      (* ❌ Variants not supported *)
      variant
  end.

Definition type_to_var_annot
  (function_parameter :
    option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot)
  : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot :=
  match function_parameter with
  | None => None
  | Some (Type_annot s) =>
    Some
      (* ❌ Variants not supported *)
      variant
  end.

Definition var_to_field_annot
  (function_parameter :
    option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  : option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot :=
  match function_parameter with
  | None => None
  | Some (Var_annot s) =>
    Some
      (* ❌ Variants not supported *)
      variant
  end.

Definition default_annot {A : Type}
  (default : option A) (function_parameter : option A) : option A :=
  match function_parameter with
  | None => default
  | annot => annot
  end.

Definition gen_access_annot
  (value_annot : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  (op_staroptstar :
    option (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot))
  : option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot ->
    option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot :=
  let default :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => None
    end in
  fun field_annot =>
    match (value_annot, field_annot, default) with
    |
      (None, None, _) | (Some _, None, None) |
        (None, Some (Field_annot "" % string), _) => None
    | (None, Some (Field_annot f), _) =>
      Some
        (* ❌ Variants not supported *)
        variant
    |
      (Some (Var_annot v), None | Some (Field_annot "" % string),
        Some (Field_annot f)) =>
      Some
        (* ❌ Variants not supported *)
        variant
    | (Some (Var_annot v), Some (Field_annot f), _) =>
      Some
        (* ❌ Variants not supported *)
        variant
    end.

Definition merge_type_annot
  (legacy : bool)
  (annot1 : option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot)
  (annot2 : option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot) :=
  match (annot1, annot2) with
  | (None, None) | (Some _, None) | (None, Some _) => ok None
  | (Some (Type_annot a1), Some (Type_annot a2)) =>
    if op_pipepipe legacy (String.equal a1 a2) then
      ok annot1
    else
      error
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_annotations
          (op_caret ":" % string a1) (op_caret ":" % string a2))
  end.

Definition merge_field_annot
  (legacy : bool)
  (annot1 : option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  (annot2 : option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) :=
  match (annot1, annot2) with
  | (None, None) | (Some _, None) | (None, Some _) => ok None
  | (Some (Field_annot a1), Some (Field_annot a2)) =>
    if op_pipepipe legacy (String.equal a1 a2) then
      ok annot1
    else
      error
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_annotations
          (op_caret "%" % string a1) (op_caret "%" % string a2))
  end.

Definition merge_var_annot
  (annot1 : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  (annot2 : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot :=
  match (annot1, annot2) with
  | (None, None) | (Some _, None) | (None, Some _) => None
  | (Some (Var_annot a1), Some (Var_annot a2)) =>
    if String.equal a1 a2 then
      annot1
    else
      None
  end.

Definition error_unexpected_annot {A : Type}
  (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (annot : list A)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
  match annot with
  | [] => ok tt
  | cons _ _ =>
    error
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
        loc)
  end.

Definition fail_unexpected_annot {A : Type}
  (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (annot : list A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  Lwt.__return (error_unexpected_annot loc annot).

Definition parse_annots
  (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (op_staroptstar : option bool)
  : option bool ->
    list string ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (list variant) :=
  let allow_special_var :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => false
    end in
  fun op_staroptstar =>
    let allow_special_field :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => false
      end in
    fun l =>
      let sub_or_wildcard {A : Type}
        (specials : list ascii) (wrap : option string -> A) (s : string) (acc :
        list A)
        : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (list A) :=
        let len := String.length s in
        if
          Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
            len 1 then
          op_atat ok (cons (wrap None) acc)
        else
          match String.get s 1 with
          |
            "a" % char |
              "b" % char |
                "c" % char |
                  "d" % char |
                    "e" % char |
                      "f" % char |
                        "g" % char |
                          "h" % char |
                            "i" % char |
                              "j" % char |
                                "k" % char |
                                  "l" % char |
                                    "m" % char |
                                      "n" % char |
                                        "o" % char |
                                          "p" % char |
                                            "q" % char |
                                              "r" % char |
                                                "s" % char |
                                                  "t" % char |
                                                    "u" % char |
                                                      "v" % char |
                                                        "w" % char |
                                                          "x" % char |
                                                            "y" % char |
                                                              "z" % char |
              "A" % char |
                "B" % char |
                  "C" % char |
                    "D" % char |
                      "E" % char |
                        "F" % char |
                          "G" % char |
                            "H" % char |
                              "I" % char |
                                "J" % char |
                                  "K" % char |
                                    "L" % char |
                                      "M" % char |
                                        "N" % char |
                                          "O" % char |
                                            "P" % char |
                                              "Q" % char |
                                                "R" % char |
                                                  "S" % char |
                                                    "T" % char |
                                                      "U" % char |
                                                        "V" % char |
                                                          "W" % char |
                                                            "X" % char |
                                                              "Y" % char |
                                                                "Z" % char |
              "_" % char =>
            op_atat ok
              (cons (wrap (Some (String.sub s 1 (op_minus len 1)))) acc)
          | "@" % char => op_atat ok (cons (wrap (Some "@" % string)) acc)
          | "%" % char =>
            if
              Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
                len 2 then
              op_atat ok (cons (wrap (Some "%" % string)) acc)
            else
              if
                op_andand
                  (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
                    len 3)
                  (Tezos_protocol_environment_alpha__Environment.Compare.Char.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
                    (String.get s 2) "%" % char) then
                op_atat ok (cons (wrap (Some "%%" % string)) acc)
              else
                error
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                    loc)
          | _ =>
            error
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                loc)
          end in
      op_gtpipequestion
        (List.fold_left
          (fun acc =>
            fun s =>
              op_gtgtquestion acc
                (fun acc =>
                  if
                    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
                      (String.length s) 0 then
                    error
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                        loc)
                  else
                    match String.get s 0 with
                    | ":" % char =>
                      sub_or_wildcard []
                        (fun a =>
                          (* ❌ Variants not supported *)
                          variant) s acc
                    | "@" % char =>
                      sub_or_wildcard
                        (if allow_special_var then
                          cons "%" % char []
                        else
                          [])
                        (fun a =>
                          (* ❌ Variants not supported *)
                          variant) s acc
                    | "%" % char =>
                      sub_or_wildcard
                        (if allow_special_field then
                          cons "@" % char []
                        else
                          [])
                        (fun a =>
                          (* ❌ Variants not supported *)
                          variant) s acc
                    | _ =>
                      error
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                          loc)
                    end)) (ok []) l) List.rev.

Definition opt_var_of_var_opt (function_parameter : variant) : option variant :=
  match function_parameter with
  | Var_annot None => None
  | Var_annot (Some a) =>
    Some
      (* ❌ Variants not supported *)
      variant
  end.

Definition opt_field_of_field_opt (function_parameter : variant)
  : option variant :=
  match function_parameter with
  | Field_annot None => None
  | Field_annot (Some a) =>
    Some
      (* ❌ Variants not supported *)
      variant
  end.

Definition opt_type_of_type_opt (function_parameter : variant)
  : option variant :=
  match function_parameter with
  | Type_annot None => None
  | Type_annot (Some a) =>
    Some
      (* ❌ Variants not supported *)
      variant
  end.

Definition classify_annot
  (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (l : list variant)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (list (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot) *
      list (option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot) *
      list (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)) :=
  (* ❌ Try-with are not handled *)
  try
    (let '(_, rv, _, rt, _, rf) :=
      List.fold_left
        (fun function_parameter =>
          let '(in_v, rv, in_t, rt, in_f, rf) := function_parameter in
          fun a =>
            match (a, in_v, rv, in_t, rt, in_f, rf) with
            |
              ((Var_annot _) as a, true, _, _, _, _, _) |
                ((Var_annot _) as a, false, [], _, _, _, _) =>
              (true, (cons (opt_var_of_var_opt a) rv), false, rt, false, rf)
            |
              ((Type_annot _) as a, _, _, true, _, _, _) |
                ((Type_annot _) as a, _, _, false, [], _, _) =>
              (false, rv, true, (cons (opt_type_of_type_opt a) rt), false, rf)
            |
              ((Field_annot _) as a, _, _, _, _, true, _) |
                ((Field_annot _) as a, _, _, _, _, false, []) =>
              (false, rv, false, rt, true, (cons (opt_field_of_field_opt a) rf))
            | _ => raise Exit
            end) (false, [], false, [], false, []) l in
    ok ((List.rev rv), (List.rev rt), (List.rev rf))).

Definition get_one_annot {A : Type}
  (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (function_parameter : list (option A))
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option A) :=
  match function_parameter with
  | [] => ok None
  | cons a [] => ok a
  | _ =>
    error
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
        loc)
  end.

Definition get_two_annot {A : Type}
  (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (function_parameter : list (option A))
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option A * option A) :=
  match function_parameter with
  | [] => ok (None, None)
  | cons a [] => ok (a, None)
  | cons a (cons b []) => ok (a, b)
  | _ =>
    error
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
        loc)
  end.

Definition parse_type_annot (loc : Z) (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot) :=
  op_gtgtquestion
    (op_gtgtquestion (parse_annots loc None None annot) (classify_annot loc))
    (fun function_parameter =>
      let '(vars, types, fields) := function_parameter in
      op_gtgtquestion (error_unexpected_annot loc vars)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtquestion (error_unexpected_annot loc fields)
            (fun function_parameter =>
              let 'tt := function_parameter in
              get_one_annot loc types))).

Definition parse_type_field_annot (loc : Z) (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) :=
  op_gtgtquestion
    (op_gtgtquestion (parse_annots loc None None annot) (classify_annot loc))
    (fun function_parameter =>
      let '(vars, types, fields) := function_parameter in
      op_gtgtquestion (error_unexpected_annot loc vars)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtquestion (get_one_annot loc types)
            (fun t =>
              op_gtpipequestion (get_one_annot loc fields) (fun f => (t, f))))).

Definition parse_composed_type_annot (loc : Z) (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) :=
  op_gtgtquestion
    (op_gtgtquestion (parse_annots loc None None annot) (classify_annot loc))
    (fun function_parameter =>
      let '(vars, types, fields) := function_parameter in
      op_gtgtquestion (error_unexpected_annot loc vars)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtquestion (get_one_annot loc types)
            (fun t =>
              op_gtpipequestion (get_two_annot loc fields)
                (fun function_parameter =>
                  let '(f1, f2) := function_parameter in
                  (t, f1, f2))))).

Definition parse_field_annot (loc : Z) (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) :=
  op_gtgtquestion
    (op_gtgtquestion (parse_annots loc None None annot) (classify_annot loc))
    (fun function_parameter =>
      let '(vars, types, fields) := function_parameter in
      op_gtgtquestion (error_unexpected_annot loc vars)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtquestion (error_unexpected_annot loc types)
            (fun function_parameter =>
              let 'tt := function_parameter in
              get_one_annot loc fields))).

Definition extract_field_annot
  (function_parameter : Tezos_raw_protocol_alpha.Alpha_context.Script.node)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_raw_protocol_alpha.Alpha_context.Script.node *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) :=
  match function_parameter with
  |
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc prim args
      annot =>
    let fix extract_first (acc : list string) (function_parameter : list string)
      : option string *
        Tezos_protocol_environment_alpha__Environment.Micheline.annot :=
      match function_parameter with
      | [] => (None, annot)
      | cons s rest =>
        if
          op_andand
            (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
              (String.length s) 0)
            (Tezos_protocol_environment_alpha__Environment.Compare.Char.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
              (String.get s 0) "%" % char) then
          ((Some s), (List.rev_append acc rest))
        else
          extract_first (cons s acc) rest
      end in
    let '(field_annot, annot) := extract_first [] annot in
    let field_annot :=
      match field_annot with
      | None => None
      | Some field_annot =>
        Some
          (* ❌ Variants not supported *)
          variant
      end in
    ok
      ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc prim
        args annot), field_annot)
  | expr => ok (expr, None)
  end.

Definition check_correct_field
  (f1 : option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  (f2 : option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
  match (f1, f2) with
  | (None, _) | (_, None) => ok tt
  | (Some (Field_annot s1), Some (Field_annot s2)) =>
    if String.equal s1 s2 then
      ok tt
    else
      error
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_field_annotations
          (op_caret "%" % string s1) (op_caret "%" % string s2))
  end.

Definition parse_var_annot
  (loc : Z)
  (default : option (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot))
  (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot) :=
  op_gtgtquestion
    (op_gtgtquestion (parse_annots loc None None annot) (classify_annot loc))
    (fun function_parameter =>
      let '(vars, types, fields) := function_parameter in
      op_gtgtquestion (error_unexpected_annot loc types)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtquestion (error_unexpected_annot loc fields)
            (fun function_parameter =>
              let 'tt := function_parameter in
              op_gtpipequestion (get_one_annot loc vars)
                (fun function_parameter =>
                  match function_parameter with
                  | (Some _) as a => a
                  | None =>
                    match default with
                    | Some a => a
                    | None => None
                    end
                  end)))).

Definition split_last_dot (function_parameter : option variant)
  : option variant * option variant :=
  match function_parameter with
  | None => (None, None)
  | Some (Field_annot s) =>
    match String.rindex_opt s "." % char with
    | None =>
      (None,
        (Some
          (* ❌ Variants not supported *)
          variant))
    | Some i =>
      let s1 := String.sub s 0 i in
      let s2 :=
        String.sub s (op_plus i 1) (op_minus (op_minus (String.length s) i) 1)
        in
      let f :=
        if
          op_pipepipe
            (Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.equal)
              s2 "car" % string)
            (Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.equal)
              s2 "cdr" % string) then
          None
        else
          Some
            (* ❌ Variants not supported *)
            variant in
      ((Some
        (* ❌ Variants not supported *)
        variant), f)
    end
  end.

Definition common_prefix (v1 : option variant) (v2 : option variant)
  : option variant :=
  match (v1, v2) with
  | (Some (Var_annot s1), Some (Var_annot s2)) => v1
  | (Some _, None) => v1
  | (None, Some _) => v2
  | (_, _) => None
  end.

Definition parse_constr_annot
  (loc : Z)
  (if_special_first :
    option (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot))
  (if_special_second :
    option (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot))
  (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) :=
  op_gtgtquestion
    (op_gtgtquestion (parse_annots loc None (Some true) annot)
      (classify_annot loc))
    (fun function_parameter =>
      let '(vars, types, fields) := function_parameter in
      op_gtgtquestion (get_one_annot loc vars)
        (fun v =>
          op_gtgtquestion (get_one_annot loc types)
            (fun t =>
              op_gtgtquestion (get_two_annot loc fields)
                (fun function_parameter =>
                  let '(f1, f2) := function_parameter in
                  op_gtgtquestion
                    match (if_special_first, f1) with
                    | (Some special_var, Some (Field_annot "@" % string)) =>
                      ok (split_last_dot special_var)
                    | (None, Some (Field_annot "@" % string)) =>
                      error
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                          loc)
                    | (_, _) => ok (v, f1)
                    end
                    (fun function_parameter =>
                      let '(v1, f1) := function_parameter in
                      op_gtpipequestion
                        match (if_special_second, f2) with
                        | (Some special_var, Some (Field_annot "@" % string)) =>
                          ok (split_last_dot special_var)
                        | (None, Some (Field_annot "@" % string)) =>
                          error
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                              loc)
                        | (_, _) => ok (v, f2)
                        end
                        (fun function_parameter =>
                          let '(v2, f2) := function_parameter in
                          let v :=
                            match v with
                            | None => common_prefix v1 v2
                            | Some _ => v
                            end in
                          (v, t, f1, f2))))))).

Definition parse_two_var_annot (loc : Z) (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot) :=
  op_gtgtquestion
    (op_gtgtquestion (parse_annots loc None None annot) (classify_annot loc))
    (fun function_parameter =>
      let '(vars, types, fields) := function_parameter in
      op_gtgtquestion (error_unexpected_annot loc types)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtquestion (error_unexpected_annot loc fields)
            (fun function_parameter =>
              let 'tt := function_parameter in
              get_two_annot loc vars))).

Definition parse_destr_annot
  (loc : Z) (annot : list string)
  (default_accessor :
    option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  (field_name : option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  (pair_annot : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  (value_annot : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) :=
  op_gtgtquestion
    (op_gtgtquestion (parse_annots loc (Some true) None annot)
      (classify_annot loc))
    (fun function_parameter =>
      let '(vars, types, fields) := function_parameter in
      op_gtgtquestion (error_unexpected_annot loc types)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtquestion (get_one_annot loc vars)
            (fun v =>
              op_gtpipequestion (get_one_annot loc fields)
                (fun f =>
                  let default :=
                    gen_access_annot pair_annot (Some default_accessor)
                      field_name in
                  let v :=
                    match v with
                    | Some (Var_annot "%" % string) =>
                      field_to_var_annot field_name
                    | Some (Var_annot "%%" % string) => default
                    | Some _ => v
                    | None => value_annot
                    end in
                  (v, f))))).

Definition parse_entrypoint_annot
  (loc : Z)
  (default : option (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot))
  (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) :=
  op_gtgtquestion
    (op_gtgtquestion (parse_annots loc None None annot) (classify_annot loc))
    (fun function_parameter =>
      let '(vars, types, fields) := function_parameter in
      op_gtgtquestion (error_unexpected_annot loc types)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtquestion (get_one_annot loc fields)
            (fun f =>
              op_gtpipequestion (get_one_annot loc vars)
                (fun function_parameter =>
                  match function_parameter with
                  | (Some _) as a => (a, f)
                  | None =>
                    match default with
                    | Some a => (a, f)
                    | None => (None, f)
                    end
                  end)))).

Definition parse_var_type_annot (loc : Z) (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
      option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot) :=
  op_gtgtquestion
    (op_gtgtquestion (parse_annots loc None None annot) (classify_annot loc))
    (fun function_parameter =>
      let '(vars, types, fields) := function_parameter in
      op_gtgtquestion (error_unexpected_annot loc fields)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtquestion (get_one_annot loc vars)
            (fun v =>
              op_gtpipequestion (get_one_annot loc types) (fun t => (v, t))))).
script_ir_annot.mli 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Script_typed_ir

(** Default annotations *)

val default_now_annot : var_annot option

val default_amount_annot : var_annot option

val default_balance_annot : var_annot option

val default_steps_annot : var_annot option

val default_source_annot : var_annot option

val default_sender_annot : var_annot option

val default_self_annot : var_annot option

val default_arg_annot : var_annot option

val default_param_annot : var_annot option

val default_storage_annot : var_annot option

val default_car_annot : field_annot option

val default_cdr_annot : field_annot option

val default_contract_annot : field_annot option

val default_addr_annot : field_annot option

val default_manager_annot : field_annot option

val default_pack_annot : field_annot option

val default_unpack_annot : field_annot option

val default_slice_annot : field_annot option

val default_elt_annot : field_annot option

val default_key_annot : field_annot option

val default_hd_annot : field_annot option

val default_tl_annot : field_annot option

val default_some_annot : field_annot option

val default_left_annot : field_annot option

val default_right_annot : field_annot option

val default_binding_annot : field_annot option

(** Unparse annotations to their string representation *)

val unparse_type_annot : type_annot option -> string list

val unparse_var_annot : var_annot option -> string list

val unparse_field_annot : field_annot option -> string list

(** Convertions functions between different annotation kinds *)

val field_to_var_annot : field_annot option -> var_annot option

val type_to_var_annot : type_annot option -> var_annot option

val var_to_field_annot : var_annot option -> field_annot option

(** Replace an annotation by its default value if it is [None] *)
val default_annot : default:'a option -> 'a option -> 'a option

(** Generate annotation for field accesses, of the form [var.field1.field2] *)
val gen_access_annot :
  var_annot option ->
  ?default:field_annot option ->
  field_annot option ->
  var_annot option

(** Merge type annotations.
    @return an error {!Inconsistent_type_annotations} if they are both present
    and different, unless [legacy] *)
val merge_type_annot :
  legacy:bool ->
  type_annot option ->
  type_annot option ->
  type_annot option tzresult

(** Merge field annotations.
    @return an error {!Inconsistent_type_annotations} if they are both present
    and different, unless [legacy] *)
val merge_field_annot :
  legacy:bool ->
  field_annot option ->
  field_annot option ->
  field_annot option tzresult

(** Merge variable annotations, does not fail ([None] if different). *)
val merge_var_annot : var_annot option -> var_annot option -> var_annot option

(** @return an error {!Unexpected_annotation} in the monad the list is not empty. *)
val error_unexpected_annot : int -> 'a list -> unit tzresult

(** Same as {!error_unexpected_annot} in Lwt. *)
val fail_unexpected_annot : int -> 'a list -> unit tzresult Lwt.t

(** Parse a type annotation only. *)
val parse_type_annot : int -> string list -> type_annot option tzresult

(** Parse a field annotation only. *)
val parse_field_annot : int -> string list -> field_annot option tzresult

(** Parse an annotation for composed types, of the form
    [:ty_name %field] in any order. *)
val parse_type_field_annot :
  int -> string list -> (type_annot option * field_annot option) tzresult

(** Parse an annotation for composed types, of the form
    [:ty_name %field1 %field2] in any order. *)
val parse_composed_type_annot :
  int ->
  string list ->
  (type_annot option * field_annot option * field_annot option) tzresult

(** Extract and remove a field annotation from a node *)
val extract_field_annot :
  Script.node -> (Script.node * field_annot option) tzresult

(** Check that field annotations match, used for field accesses. *)
val check_correct_field :
  field_annot option -> field_annot option -> unit tzresult

(** Instruction annotations parsing *)

(** Parse a variable annotation, replaced by a default value if [None]. *)
val parse_var_annot :
  int -> ?default:var_annot option -> string list -> var_annot option tzresult

val parse_constr_annot :
  int ->
  ?if_special_first:field_annot option ->
  ?if_special_second:field_annot option ->
  string list ->
  ( var_annot option
  * type_annot option
  * field_annot option
  * field_annot option )
  tzresult

val parse_two_var_annot :
  int -> string list -> (var_annot option * var_annot option) tzresult

val parse_destr_annot :
  int ->
  string list ->
  default_accessor:field_annot option ->
  field_name:field_annot option ->
  pair_annot:var_annot option ->
  value_annot:var_annot option ->
  (var_annot option * field_annot option) tzresult

val parse_entrypoint_annot :
  int ->
  ?default:var_annot option ->
  string list ->
  (var_annot option * field_annot option) tzresult

val parse_var_type_annot :
  int -> string list -> (var_annot option * type_annot option) tzresult
script_ir_annot_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter default_now_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter default_amount_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter default_balance_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter default_steps_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter default_source_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter default_sender_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter default_self_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter default_arg_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter default_param_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter default_storage_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter default_car_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_cdr_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_contract_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_addr_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_manager_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_pack_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_unpack_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_slice_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_elt_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_key_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_hd_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_tl_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_some_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_left_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_right_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_binding_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter unparse_type_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot -> list string.

Parameter unparse_var_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot -> list string.

Parameter unparse_field_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot -> list string.

Parameter field_to_var_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter type_to_var_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter var_to_field_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot.

Parameter default_annot : forall {a : Type}, option a -> option a -> option a.

Parameter gen_access_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot ->
  option (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) ->
    option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot ->
      option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter merge_type_annot :
bool ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot ->
    option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot).

Parameter merge_field_annot :
bool ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot ->
    option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot).

Parameter merge_var_annot :
option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot ->
    option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot.

Parameter error_unexpected_annot : forall {a : Type},
Z ->
  list a ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.

Parameter fail_unexpected_annot : forall {a : Type},
Z ->
  list a ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit).

Parameter parse_type_annot :
Z ->
  list string ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot).

Parameter parse_field_annot :
Z ->
  list string ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot).

Parameter parse_type_field_annot :
Z ->
  list string ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot *
        option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot).

Parameter parse_composed_type_annot :
Z ->
  list string ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot *
        option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot *
        option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot).

Parameter extract_field_annot :
Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_raw_protocol_alpha.Alpha_context.Script.node *
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot).

Parameter check_correct_field :
option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot ->
  option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit.

Parameter parse_var_annot :
Z ->
  option (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot) ->
    list string ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot).

Parameter parse_constr_annot :
Z ->
  option (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) ->
    option (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot) ->
      list string ->
        Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
            option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot *
            option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot *
            option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot).

Parameter parse_two_var_annot :
Z ->
  list string ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
        option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot).

Parameter parse_destr_annot :
Z ->
  list string ->
    option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot ->
      option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot ->
        option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot ->
          option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot ->
            Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
                option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot).

Parameter parse_entrypoint_annot :
Z ->
  option (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot) ->
    list string ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
          option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot).

Parameter parse_var_type_annot :
Z ->
  list string ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
        option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot).
script_ir_translator.ml 219 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Micheline
open Script
open Script_typed_ir
open Script_tc_errors
open Script_ir_annot
module Typecheck_costs = Michelson_v1_gas.Cost_of.Typechecking
module Unparse_costs = Michelson_v1_gas.Cost_of.Unparse

type ex_comparable_ty =
  | Ex_comparable_ty : 'a comparable_ty -> ex_comparable_ty

type ex_ty = Ex_ty : 'a ty -> ex_ty

type ex_stack_ty = Ex_stack_ty : 'a stack_ty -> ex_stack_ty

type tc_context =
  | Lambda : tc_context
  | Dip : 'a stack_ty * tc_context -> tc_context
  | Toplevel : {
      storage_type : 'sto ty;
      param_type : 'param ty;
      root_name : string option;
      legacy_create_contract_literal : bool;
    }
      -> tc_context

type unparsing_mode = Optimized | Readable

type type_logger =
  int ->
  (Script.expr * Script.annot) list ->
  (Script.expr * Script.annot) list ->
  unit

let add_dip ty annot prev =
  match prev with
  | Lambda | Toplevel _ ->
      Dip (Item_t (ty, Empty_t, annot), prev)
  | Dip (stack, _) ->
      Dip (Item_t (ty, stack, annot), prev)

(* ---- Type size accounting ------------------------------------------------*)

let rec comparable_type_size : type t a. (t, a) comparable_struct -> int =
 fun ty ->
  (* No wildcard to force the update when comparable_ty chages. *)
  match ty with
  | Int_key _ ->
      1
  | Nat_key _ ->
      1
  | String_key _ ->
      1
  | Bytes_key _ ->
      1
  | Mutez_key _ ->
      1
  | Bool_key _ ->
      1
  | Key_hash_key _ ->
      1
  | Timestamp_key _ ->
      1
  | Address_key _ ->
      1
  | Pair_key (_, (t, _), _) ->
      1 + comparable_type_size t

let rec type_size : type t. t ty -> int =
 fun ty ->
  match ty with
  | Unit_t _ ->
      1
  | Int_t _ ->
      1
  | Nat_t _ ->
      1
  | Signature_t _ ->
      1
  | Bytes_t _ ->
      1
  | String_t _ ->
      1
  | Mutez_t _ ->
      1
  | Key_hash_t _ ->
      1
  | Key_t _ ->
      1
  | Timestamp_t _ ->
      1
  | Address_t _ ->
      1
  | Bool_t _ ->
      1
  | Operation_t _ ->
      1
  | Pair_t ((l, _, _), (r, _, _), _, _) ->
      1 + type_size l + type_size r
  | Union_t ((l, _), (r, _), _, _) ->
      1 + type_size l + type_size r
  | Lambda_t (arg, ret, _) ->
      1 + type_size arg + type_size ret
  | Option_t (t, _, _) ->
      1 + type_size t
  | List_t (t, _, _) ->
      1 + type_size t
  | Set_t (k, _) ->
      1 + comparable_type_size k
  | Map_t (k, v, _, _) ->
      1 + comparable_type_size k + type_size v
  | Big_map_t (k, v, _) ->
      1 + comparable_type_size k + type_size v
  | Contract_t (arg, _) ->
      1 + type_size arg
  | Chain_id_t _ ->
      1

let rec type_size_of_stack_head : type st. st stack_ty -> up_to:int -> int =
 fun stack ~up_to ->
  match stack with
  | Empty_t ->
      0
  | Item_t (head, tail, _annot) ->
      if Compare.Int.(up_to > 0) then
        Compare.Int.max
          (type_size head)
          (type_size_of_stack_head tail ~up_to:(up_to - 1))
      else 0

(* This is the depth of the stack to inspect for sizes overflow. We
   only need to check the produced types that can be larger than the
   arguments. That's why Swap is 0 for instance as no type grows.
   Constant sized types are not checked: it is assumed they are lower
   than the bound (otherwise every program would be rejected). *)
let number_of_generated_growing_types : type b a. (b, a) instr -> int =
  function
  | Drop ->
      0
  | Dup ->
      0
  | Swap ->
      0
  | Const _ ->
      1
  | Cons_pair ->
      1
  | Car ->
      0
  | Cdr ->
      0
  | Cons_some ->
      1
  | Cons_none _ ->
      1
  | If_none _ ->
      0
  | Left ->
      0
  | Right ->
      0
  | If_left _ ->
      0
  | Cons_list ->
      1
  | Nil ->
      1
  | If_cons _ ->
      0
  | List_map _ ->
      1
  | List_size ->
      0
  | List_iter _ ->
      1
  | Empty_set _ ->
      1
  | Set_iter _ ->
      0
  | Set_mem ->
      0
  | Set_update ->
      0
  | Set_size ->
      0
  | Empty_map _ ->
      1
  | Map_map _ ->
      1
  | Map_iter _ ->
      1
  | Map_mem ->
      0
  | Map_get ->
      0
  | Map_update ->
      0
  | Map_size ->
      0
  | Empty_big_map _ ->
      1
  | Big_map_get ->
      0
  | Big_map_update ->
      0
  | Big_map_mem ->
      0
  | Concat_string ->
      0
  | Concat_string_pair ->
      0
  | Slice_string ->
      0
  | String_size ->
      0
  | Concat_bytes ->
      0
  | Concat_bytes_pair ->
      0
  | Slice_bytes ->
      0
  | Bytes_size ->
      0
  | Add_seconds_to_timestamp ->
      0
  | Add_timestamp_to_seconds ->
      0
  | Sub_timestamp_seconds ->
      0
  | Diff_timestamps ->
      0
  | Add_tez ->
      0
  | Sub_tez ->
      0
  | Mul_teznat ->
      0
  | Mul_nattez ->
      0
  | Ediv_teznat ->
      0
  | Ediv_tez ->
      0
  | Or ->
      0
  | And ->
      0
  | Xor ->
      0
  | Not ->
      0
  | Is_nat ->
      0
  | Neg_nat ->
      0
  | Neg_int ->
      0
  | Abs_int ->
      0
  | Int_nat ->
      0
  | Add_intint ->
      0
  | Add_intnat ->
      0
  | Add_natint ->
      0
  | Add_natnat ->
      0
  | Sub_int ->
      0
  | Mul_intint ->
      0
  | Mul_intnat ->
      0
  | Mul_natint ->
      0
  | Mul_natnat ->
      0
  | Ediv_intint ->
      0
  | Ediv_intnat ->
      0
  | Ediv_natint ->
      0
  | Ediv_natnat ->
      0
  | Lsl_nat ->
      0
  | Lsr_nat ->
      0
  | Or_nat ->
      0
  | And_nat ->
      0
  | And_int_nat ->
      0
  | Xor_nat ->
      0
  | Not_nat ->
      0
  | Not_int ->
      0
  | Seq _ ->
      0
  | If _ ->
      0
  | Loop _ ->
      0
  | Loop_left _ ->
      0
  | Dip _ ->
      0
  | Exec ->
      0
  | Apply _ ->
      0
  | Lambda _ ->
      1
  | Failwith _ ->
      1
  | Nop ->
      0
  | Compare _ ->
      1
  | Eq ->
      0
  | Neq ->
      0
  | Lt ->
      0
  | Gt ->
      0
  | Le ->
      0
  | Ge ->
      0
  | Address ->
      0
  | Contract _ ->
      1
  | Transfer_tokens ->
      1
  | Create_account ->
      0
  | Implicit_account ->
      0
  | Create_contract _ ->
      1
  | Create_contract_2 _ ->
      1
  | Now ->
      0
  | Balance ->
      0
  | Check_signature ->
      0
  | Hash_key ->
      0
  | Blake2b ->
      0
  | Sha256 ->
      0
  | Sha512 ->
      0
  | Steps_to_quota ->
      0
  | Source ->
      0
  | Sender ->
      0
  | Self _ ->
      1
  | Amount ->
      0
  | Set_delegate ->
      0
  | Pack _ ->
      0
  | Unpack _ ->
      1
  | Dig _ ->
      0
  | Dug _ ->
      0
  | Dipn _ ->
      0
  | Dropn _ ->
      0
  | ChainId ->
      0

(* ---- Error helpers -------------------------------------------------------*)

let location = function
  | Prim (loc, _, _, _)
  | Int (loc, _)
  | String (loc, _)
  | Bytes (loc, _)
  | Seq (loc, _) ->
      loc

let kind = function
  | Int _ ->
      Int_kind
  | String _ ->
      String_kind
  | Bytes _ ->
      Bytes_kind
  | Prim _ ->
      Prim_kind
  | Seq _ ->
      Seq_kind

let namespace = function
  | K_parameter | K_storage | K_code ->
      Keyword_namespace
  | D_False
  | D_Elt
  | D_Left
  | D_None
  | D_Pair
  | D_Right
  | D_Some
  | D_True
  | D_Unit ->
      Constant_namespace
  | I_PACK
  | I_UNPACK
  | I_BLAKE2B
  | I_SHA256
  | I_SHA512
  | I_ABS
  | I_ADD
  | I_AMOUNT
  | I_AND
  | I_BALANCE
  | I_CAR
  | I_CDR
  | I_CHAIN_ID
  | I_CHECK_SIGNATURE
  | I_COMPARE
  | I_CONCAT
  | I_CONS
  | I_CREATE_ACCOUNT
  | I_CREATE_CONTRACT
  | I_IMPLICIT_ACCOUNT
  | I_DIP
  | I_DROP
  | I_DUP
  | I_EDIV
  | I_EMPTY_BIG_MAP
  | I_EMPTY_MAP
  | I_EMPTY_SET
  | I_EQ
  | I_EXEC
  | I_APPLY
  | I_FAILWITH
  | I_GE
  | I_GET
  | I_GT
  | I_HASH_KEY
  | I_IF
  | I_IF_CONS
  | I_IF_LEFT
  | I_IF_NONE
  | I_INT
  | I_LAMBDA
  | I_LE
  | I_LEFT
  | I_LOOP
  | I_LSL
  | I_LSR
  | I_LT
  | I_MAP
  | I_MEM
  | I_MUL
  | I_NEG
  | I_NEQ
  | I_NIL
  | I_NONE
  | I_NOT
  | I_NOW
  | I_OR
  | I_PAIR
  | I_PUSH
  | I_RIGHT
  | I_SIZE
  | I_SOME
  | I_SOURCE
  | I_SENDER
  | I_SELF
  | I_SLICE
  | I_STEPS_TO_QUOTA
  | I_SUB
  | I_SWAP
  | I_TRANSFER_TOKENS
  | I_SET_DELEGATE
  | I_UNIT
  | I_UPDATE
  | I_XOR
  | I_ITER
  | I_LOOP_LEFT
  | I_ADDRESS
  | I_CONTRACT
  | I_ISNAT
  | I_CAST
  | I_RENAME
  | I_DIG
  | I_DUG ->
      Instr_namespace
  | T_bool
  | T_contract
  | T_int
  | T_key
  | T_key_hash
  | T_lambda
  | T_list
  | T_map
  | T_big_map
  | T_nat
  | T_option
  | T_or
  | T_pair
  | T_set
  | T_signature
  | T_string
  | T_bytes
  | T_mutez
  | T_timestamp
  | T_unit
  | T_operation
  | T_address
  | T_chain_id ->
      Type_namespace

let unexpected expr exp_kinds exp_ns exp_prims =
  match expr with
  | Int (loc, _) ->
      Invalid_kind (loc, Prim_kind :: exp_kinds, Int_kind)
  | String (loc, _) ->
      Invalid_kind (loc, Prim_kind :: exp_kinds, String_kind)
  | Bytes (loc, _) ->
      Invalid_kind (loc, Prim_kind :: exp_kinds, Bytes_kind)
  | Seq (loc, _) ->
      Invalid_kind (loc, Prim_kind :: exp_kinds, Seq_kind)
  | Prim (loc, name, _, _) -> (
    match (namespace name, exp_ns) with
    | (Type_namespace, Type_namespace)
    | (Instr_namespace, Instr_namespace)
    | (Constant_namespace, Constant_namespace) ->
        Invalid_primitive (loc, exp_prims, name)
    | (ns, _) ->
        Invalid_namespace (loc, name, exp_ns, ns) )

let check_kind kinds expr =
  let kind = kind expr in
  if List.mem kind kinds then return_unit
  else
    let loc = location expr in
    fail (Invalid_kind (loc, kinds, kind))

(* ---- Sets and Maps -------------------------------------------------------*)

let wrap_compare compare a b =
  let res = compare a b in
  if Compare.Int.(res = 0) then 0 else if Compare.Int.(res > 0) then 1 else -1

let rec compare_comparable :
    type a s. (a, s) comparable_struct -> a -> a -> int =
 fun kind ->
  match kind with
  | String_key _ ->
      wrap_compare Compare.String.compare
  | Bool_key _ ->
      wrap_compare Compare.Bool.compare
  | Mutez_key _ ->
      wrap_compare Tez.compare
  | Key_hash_key _ ->
      wrap_compare Signature.Public_key_hash.compare
  | Int_key _ ->
      wrap_compare Script_int.compare
  | Nat_key _ ->
      wrap_compare Script_int.compare
  | Timestamp_key _ ->
      wrap_compare Script_timestamp.compare
  | Address_key _ ->
      wrap_compare
      @@ fun (x, ex) (y, ey) ->
      let lres = Contract.compare x y in
      if Compare.Int.(lres = 0) then Compare.String.compare ex ey else lres
  | Bytes_key _ ->
      wrap_compare MBytes.compare
  | Pair_key ((tl, _), (tr, _), _) ->
      fun (lx, rx) (ly, ry) ->
        let lres = compare_comparable tl lx ly in
        if Compare.Int.(lres = 0) then compare_comparable tr rx ry else lres

let empty_set : type a. a comparable_ty -> a set =
 fun ty ->
  let module OPS = Set.Make (struct
    type t = a

    let compare = compare_comparable ty
  end) in
  ( module struct
    type elt = a

    let elt_ty = ty

    module OPS = OPS

    let boxed = OPS.empty

    let size = 0
  end )

let set_update : type a. a -> bool -> a set -> a set =
 fun v b (module Box) ->
  ( module struct
    type elt = a

    let elt_ty = Box.elt_ty

    module OPS = Box.OPS

    let boxed =
      if b then Box.OPS.add v Box.boxed else Box.OPS.remove v Box.boxed

    let size =
      let mem = Box.OPS.mem v Box.boxed in
      if mem then if b then Box.size else Box.size - 1
      else if b then Box.size + 1
      else Box.size
  end )

let set_mem : type elt. elt -> elt set -> bool =
 fun v (module Box) -> Box.OPS.mem v Box.boxed

let set_fold : type elt acc. (elt -> acc -> acc) -> elt set -> acc -> acc =
 fun f (module Box) -> Box.OPS.fold f Box.boxed

let set_size : type elt. elt set -> Script_int.n Script_int.num =
 fun (module Box) -> Script_int.(abs (of_int Box.size))

let map_key_ty : type a b. (a, b) map -> a comparable_ty =
 fun (module Box) -> Box.key_ty

let empty_map : type a b. a comparable_ty -> (a, b) map =
 fun ty ->
  let module OPS = Map.Make (struct
    type t = a

    let compare = compare_comparable ty
  end) in
  ( module struct
    type key = a

    type value = b

    let key_ty = ty

    module OPS = OPS

    let boxed = (OPS.empty, 0)
  end )

let map_get : type key value. key -> (key, value) map -> value option =
 fun k (module Box) -> Box.OPS.find_opt k (fst Box.boxed)

let map_update : type a b. a -> b option -> (a, b) map -> (a, b) map =
 fun k v (module Box) ->
  ( module struct
    type key = a

    type value = b

    let key_ty = Box.key_ty

    module OPS = Box.OPS

    let boxed =
      let (map, size) = Box.boxed in
      let contains = Box.OPS.mem k map in
      match v with
      | Some v ->
          (Box.OPS.add k v map, size + if contains then 0 else 1)
      | None ->
          (Box.OPS.remove k map, size - if contains then 1 else 0)
  end )

let map_set : type a b. a -> b -> (a, b) map -> (a, b) map =
 fun k v (module Box) ->
  ( module struct
    type key = a

    type value = b

    let key_ty = Box.key_ty

    module OPS = Box.OPS

    let boxed =
      let (map, size) = Box.boxed in
      (Box.OPS.add k v map, if Box.OPS.mem k map then size else size + 1)
  end )

let map_mem : type key value. key -> (key, value) map -> bool =
 fun k (module Box) -> Box.OPS.mem k (fst Box.boxed)

let map_fold :
    type key value acc.
    (key -> value -> acc -> acc) -> (key, value) map -> acc -> acc =
 fun f (module Box) -> Box.OPS.fold f (fst Box.boxed)

let map_size : type key value. (key, value) map -> Script_int.n Script_int.num
    =
 fun (module Box) -> Script_int.(abs (of_int (snd Box.boxed)))

(* ---- Unparsing (Typed IR -> Untyped expressions) of types -----------------*)

let rec ty_of_comparable_ty : type a s. (a, s) comparable_struct -> a ty =
  function
  | Int_key tname ->
      Int_t tname
  | Nat_key tname ->
      Nat_t tname
  | String_key tname ->
      String_t tname
  | Bytes_key tname ->
      Bytes_t tname
  | Mutez_key tname ->
      Mutez_t tname
  | Bool_key tname ->
      Bool_t tname
  | Key_hash_key tname ->
      Key_hash_t tname
  | Timestamp_key tname ->
      Timestamp_t tname
  | Address_key tname ->
      Address_t tname
  | Pair_key ((l, al), (r, ar), tname) ->
      Pair_t
        ( (ty_of_comparable_ty l, al, None),
          (ty_of_comparable_ty r, ar, None),
          tname,
          false )

let rec comparable_ty_of_ty : type a. a ty -> a comparable_ty option = function
  | Int_t tname ->
      Some (Int_key tname)
  | Nat_t tname ->
      Some (Nat_key tname)
  | String_t tname ->
      Some (String_key tname)
  | Bytes_t tname ->
      Some (Bytes_key tname)
  | Mutez_t tname ->
      Some (Mutez_key tname)
  | Bool_t tname ->
      Some (Bool_key tname)
  | Key_hash_t tname ->
      Some (Key_hash_key tname)
  | Timestamp_t tname ->
      Some (Timestamp_key tname)
  | Address_t tname ->
      Some (Address_key tname)
  | Pair_t ((l, al, _), (r, ar, _), pname, _) -> (
    match comparable_ty_of_ty r with
    | None ->
        None
    | Some rty -> (
      match comparable_ty_of_ty l with
      | None ->
          None
      | Some (Pair_key _) ->
          None (* not a comb *)
      | Some (Int_key tname) ->
          Some (Pair_key ((Int_key tname, al), (rty, ar), pname))
      | Some (Nat_key tname) ->
          Some (Pair_key ((Nat_key tname, al), (rty, ar), pname))
      | Some (String_key tname) ->
          Some (Pair_key ((String_key tname, al), (rty, ar), pname))
      | Some (Bytes_key tname) ->
          Some (Pair_key ((Bytes_key tname, al), (rty, ar), pname))
      | Some (Mutez_key tname) ->
          Some (Pair_key ((Mutez_key tname, al), (rty, ar), pname))
      | Some (Bool_key tname) ->
          Some (Pair_key ((Bool_key tname, al), (rty, ar), pname))
      | Some (Key_hash_key tname) ->
          Some (Pair_key ((Key_hash_key tname, al), (rty, ar), pname))
      | Some (Timestamp_key tname) ->
          Some (Pair_key ((Timestamp_key tname, al), (rty, ar), pname))
      | Some (Address_key tname) ->
          Some (Pair_key ((Address_key tname, al), (rty, ar), pname)) ) )
  | _ ->
      None

let add_field_annot a var = function
  | Prim (loc, prim, args, annots) ->
      Prim
        ( loc,
          prim,
          args,
          annots @ unparse_field_annot a @ unparse_var_annot var )
  | expr ->
      expr

let rec unparse_comparable_ty :
    type a s. (a, s) comparable_struct -> Script.node = function
  | Int_key tname ->
      Prim (-1, T_int, [], unparse_type_annot tname)
  | Nat_key tname ->
      Prim (-1, T_nat, [], unparse_type_annot tname)
  | String_key tname ->
      Prim (-1, T_string, [], unparse_type_annot tname)
  | Bytes_key tname ->
      Prim (-1, T_bytes, [], unparse_type_annot tname)
  | Mutez_key tname ->
      Prim (-1, T_mutez, [], unparse_type_annot tname)
  | Bool_key tname ->
      Prim (-1, T_bool, [], unparse_type_annot tname)
  | Key_hash_key tname ->
      Prim (-1, T_key_hash, [], unparse_type_annot tname)
  | Timestamp_key tname ->
      Prim (-1, T_timestamp, [], unparse_type_annot tname)
  | Address_key tname ->
      Prim (-1, T_address, [], unparse_type_annot tname)
  | Pair_key ((l, al), (r, ar), pname) ->
      let tl = add_field_annot al None (unparse_comparable_ty l) in
      let tr = add_field_annot ar None (unparse_comparable_ty r) in
      Prim (-1, T_pair, [tl; tr], unparse_type_annot pname)

let rec unparse_ty_no_lwt :
    type a. context -> a ty -> (Script.node * context) tzresult =
 fun ctxt ty ->
  Gas.consume ctxt Unparse_costs.cycle
  >>? fun ctxt ->
  let return ctxt (name, args, annot) =
    let result = Prim (-1, name, args, annot) in
    Gas.consume ctxt (Unparse_costs.prim_cost (List.length args) annot)
    >>? fun ctxt -> ok (result, ctxt)
  in
  match ty with
  | Unit_t tname ->
      return ctxt (T_unit, [], unparse_type_annot tname)
  | Int_t tname ->
      return ctxt (T_int, [], unparse_type_annot tname)
  | Nat_t tname ->
      return ctxt (T_nat, [], unparse_type_annot tname)
  | String_t tname ->
      return ctxt (T_string, [], unparse_type_annot tname)
  | Bytes_t tname ->
      return ctxt (T_bytes, [], unparse_type_annot tname)
  | Mutez_t tname ->
      return ctxt (T_mutez, [], unparse_type_annot tname)
  | Bool_t tname ->
      return ctxt (T_bool, [], unparse_type_annot tname)
  | Key_hash_t tname ->
      return ctxt (T_key_hash, [], unparse_type_annot tname)
  | Key_t tname ->
      return ctxt (T_key, [], unparse_type_annot tname)
  | Timestamp_t tname ->
      return ctxt (T_timestamp, [], unparse_type_annot tname)
  | Address_t tname ->
      return ctxt (T_address, [], unparse_type_annot tname)
  | Signature_t tname ->
      return ctxt (T_signature, [], unparse_type_annot tname)
  | Operation_t tname ->
      return ctxt (T_operation, [], unparse_type_annot tname)
  | Chain_id_t tname ->
      return ctxt (T_chain_id, [], unparse_type_annot tname)
  | Contract_t (ut, tname) ->
      unparse_ty_no_lwt ctxt ut
      >>? fun (t, ctxt) ->
      return ctxt (T_contract, [t], unparse_type_annot tname)
  | Pair_t ((utl, l_field, l_var), (utr, r_field, r_var), tname, _) ->
      let annot = unparse_type_annot tname in
      unparse_ty_no_lwt ctxt utl
      >>? fun (utl, ctxt) ->
      let tl = add_field_annot l_field l_var utl in
      unparse_ty_no_lwt ctxt utr
      >>? fun (utr, ctxt) ->
      let tr = add_field_annot r_field r_var utr in
      return ctxt (T_pair, [tl; tr], annot)
  | Union_t ((utl, l_field), (utr, r_field), tname, _) ->
      let annot = unparse_type_annot tname in
      unparse_ty_no_lwt ctxt utl
      >>? fun (utl, ctxt) ->
      let tl = add_field_annot l_field None utl in
      unparse_ty_no_lwt ctxt utr
      >>? fun (utr, ctxt) ->
      let tr = add_field_annot r_field None utr in
      return ctxt (T_or, [tl; tr], annot)
  | Lambda_t (uta, utr, tname) ->
      unparse_ty_no_lwt ctxt uta
      >>? fun (ta, ctxt) ->
      unparse_ty_no_lwt ctxt utr
      >>? fun (tr, ctxt) ->
      return ctxt (T_lambda, [ta; tr], unparse_type_annot tname)
  | Option_t (ut, tname, _) ->
      let annot = unparse_type_annot tname in
      unparse_ty_no_lwt ctxt ut
      >>? fun (ut, ctxt) -> return ctxt (T_option, [ut], annot)
  | List_t (ut, tname, _) ->
      unparse_ty_no_lwt ctxt ut
      >>? fun (t, ctxt) -> return ctxt (T_list, [t], unparse_type_annot tname)
  | Set_t (ut, tname) ->
      let t = unparse_comparable_ty ut in
      return ctxt (T_set, [t], unparse_type_annot tname)
  | Map_t (uta, utr, tname, _) ->
      let ta = unparse_comparable_ty uta in
      unparse_ty_no_lwt ctxt utr
      >>? fun (tr, ctxt) ->
      return ctxt (T_map, [ta; tr], unparse_type_annot tname)
  | Big_map_t (uta, utr, tname) ->
      let ta = unparse_comparable_ty uta in
      unparse_ty_no_lwt ctxt utr
      >>? fun (tr, ctxt) ->
      return ctxt (T_big_map, [ta; tr], unparse_type_annot tname)

let unparse_ty ctxt ty = Lwt.return (unparse_ty_no_lwt ctxt ty)

let rec strip_var_annots = function
  | (Int _ | String _ | Bytes _) as atom ->
      atom
  | Seq (loc, args) ->
      Seq (loc, List.map strip_var_annots args)
  | Prim (loc, name, args, annots) ->
      let not_var_annot s = Compare.Char.(s.[0] <> '@') in
      let annots = List.filter not_var_annot annots in
      Prim (loc, name, List.map strip_var_annots args, annots)

let serialize_ty_for_error ctxt ty =
  unparse_ty_no_lwt ctxt ty
  |> record_trace Cannot_serialize_error
  >|? fun (ty, ctxt) -> (strip_locations (strip_var_annots ty), ctxt)

let rec unparse_stack :
    type a.
    context ->
    a stack_ty ->
    ((Script.expr * Script.annot) list * context) tzresult Lwt.t =
 fun ctxt -> function
  | Empty_t ->
      return ([], ctxt)
  | Item_t (ty, rest, annot) ->
      unparse_ty ctxt ty
      >>=? fun (uty, ctxt) ->
      unparse_stack ctxt rest
      >>=? fun (urest, ctxt) ->
      return ((strip_locations uty, unparse_var_annot annot) :: urest, ctxt)

let serialize_stack_for_error ctxt stack_ty =
  trace Cannot_serialize_error (unparse_stack ctxt stack_ty)

let name_of_ty : type a. a ty -> type_annot option = function
  | Unit_t tname ->
      tname
  | Int_t tname ->
      tname
  | Nat_t tname ->
      tname
  | String_t tname ->
      tname
  | Bytes_t tname ->
      tname
  | Mutez_t tname ->
      tname
  | Bool_t tname ->
      tname
  | Key_hash_t tname ->
      tname
  | Key_t tname ->
      tname
  | Timestamp_t tname ->
      tname
  | Address_t tname ->
      tname
  | Signature_t tname ->
      tname
  | Operation_t tname ->
      tname
  | Chain_id_t tname ->
      tname
  | Contract_t (_, tname) ->
      tname
  | Pair_t (_, _, tname, _) ->
      tname
  | Union_t (_, _, tname, _) ->
      tname
  | Lambda_t (_, _, tname) ->
      tname
  | Option_t (_, tname, _) ->
      tname
  | List_t (_, tname, _) ->
      tname
  | Set_t (_, tname) ->
      tname
  | Map_t (_, _, tname, _) ->
      tname
  | Big_map_t (_, _, tname) ->
      tname

(* ---- Equality witnesses --------------------------------------------------*)

type ('ta, 'tb) eq = Eq : ('same, 'same) eq

let comparable_ty_eq :
    type ta tb.
    context ->
    ta comparable_ty ->
    tb comparable_ty ->
    (ta comparable_ty, tb comparable_ty) eq tzresult =
 fun ctxt ta tb ->
  match (ta, tb) with
  | (Int_key _, Int_key _) ->
      Ok Eq
  | (Nat_key _, Nat_key _) ->
      Ok Eq
  | (String_key _, String_key _) ->
      Ok Eq
  | (Bytes_key _, Bytes_key _) ->
      Ok Eq
  | (Mutez_key _, Mutez_key _) ->
      Ok Eq
  | (Bool_key _, Bool_key _) ->
      Ok Eq
  | (Key_hash_key _, Key_hash_key _) ->
      Ok Eq
  | (Timestamp_key _, Timestamp_key _) ->
      Ok Eq
  | (Address_key _, Address_key _) ->
      Ok Eq
  | (_, _) ->
      serialize_ty_for_error ctxt (ty_of_comparable_ty ta)
      >>? fun (ta, ctxt) ->
      serialize_ty_for_error ctxt (ty_of_comparable_ty tb)
      >>? fun (tb, _ctxt) -> error (Inconsistent_types (ta, tb))

let record_inconsistent ctxt ta tb =
  record_trace_eval (fun () ->
      serialize_ty_for_error ctxt ta
      >>? fun (ta, ctxt) ->
      serialize_ty_for_error ctxt tb
      >|? fun (tb, _ctxt) -> Inconsistent_types (ta, tb))

let record_inconsistent_type_annotations ctxt loc ta tb =
  record_trace_eval (fun () ->
      serialize_ty_for_error ctxt ta
      >>? fun (ta, ctxt) ->
      serialize_ty_for_error ctxt tb
      >|? fun (tb, _ctxt) -> Inconsistent_type_annotations (loc, ta, tb))

let rec ty_eq :
    type ta tb.
    context -> ta ty -> tb ty -> ((ta ty, tb ty) eq * context) tzresult =
 fun ctxt ta tb ->
  let ok (eq : (ta ty, tb ty) eq) ctxt nb_args :
      ((ta ty, tb ty) eq * context) tzresult =
    Gas.consume ctxt (Typecheck_costs.type_ (2 * nb_args))
    >>? fun ctxt -> Ok (eq, ctxt)
  in
  Gas.consume ctxt Typecheck_costs.cycle
  >>? fun ctxt ->
  match (ta, tb) with
  | (Unit_t _, Unit_t _) ->
      ok Eq ctxt 0
  | (Int_t _, Int_t _) ->
      ok Eq ctxt 0
  | (Nat_t _, Nat_t _) ->
      ok Eq ctxt 0
  | (Key_t _, Key_t _) ->
      ok Eq ctxt 0
  | (Key_hash_t _, Key_hash_t _) ->
      ok Eq ctxt 0
  | (String_t _, String_t _) ->
      ok Eq ctxt 0
  | (Bytes_t _, Bytes_t _) ->
      ok Eq ctxt 0
  | (Signature_t _, Signature_t _) ->
      ok Eq ctxt 0
  | (Mutez_t _, Mutez_t _) ->
      ok Eq ctxt 0
  | (Timestamp_t _, Timestamp_t _) ->
      ok Eq ctxt 0
  | (Chain_id_t _, Chain_id_t _) ->
      ok Eq ctxt 0
  | (Address_t _, Address_t _) ->
      ok Eq ctxt 0
  | (Bool_t _, Bool_t _) ->
      ok Eq ctxt 0
  | (Operation_t _, Operation_t _) ->
      ok Eq ctxt 0
  | (Map_t (tal, tar, _, _), Map_t (tbl, tbr, _, _)) ->
      comparable_ty_eq ctxt tal tbl
      >>? (fun Eq -> ty_eq ctxt tar tbr >>? fun (Eq, ctxt) -> ok Eq ctxt 2)
      |> record_inconsistent ctxt ta tb
  | (Big_map_t (tal, tar, _), Big_map_t (tbl, tbr, _)) ->
      comparable_ty_eq ctxt tal tbl
      >>? (fun Eq -> ty_eq ctxt tar tbr >>? fun (Eq, ctxt) -> ok Eq ctxt 2)
      |> record_inconsistent ctxt ta tb
  | (Set_t (ea, _), Set_t (eb, _)) ->
      comparable_ty_eq ctxt ea eb
      >>? (fun Eq -> ok Eq ctxt 1)
      |> record_inconsistent ctxt ta tb
  | ( Pair_t ((tal, _, _), (tar, _, _), _, _),
      Pair_t ((tbl, _, _), (tbr, _, _), _, _) ) ->
      ty_eq ctxt tal tbl
      >>? (fun (Eq, ctxt) ->
            ty_eq ctxt tar tbr >>? fun (Eq, ctxt) -> ok Eq ctxt 2)
      |> record_inconsistent ctxt ta tb
  | (Union_t ((tal, _), (tar, _), _, _), Union_t ((tbl, _), (tbr, _), _, _)) ->
      ty_eq ctxt tal tbl
      >>? (fun (Eq, ctxt) ->
            ty_eq ctxt tar tbr >>? fun (Eq, ctxt) -> ok Eq ctxt 2)
      |> record_inconsistent ctxt ta tb
  | (Lambda_t (tal, tar, _), Lambda_t (tbl, tbr, _)) ->
      ty_eq ctxt tal tbl
      >>? (fun (Eq, ctxt) ->
            ty_eq ctxt tar tbr >>? fun (Eq, ctxt) -> ok Eq ctxt 2)
      |> record_inconsistent ctxt ta tb
  | (Contract_t (tal, _), Contract_t (tbl, _)) ->
      ty_eq ctxt tal tbl
      >>? (fun (Eq, ctxt) -> ok Eq ctxt 1)
      |> record_inconsistent ctxt ta tb
  | (Option_t (tva, _, _), Option_t (tvb, _, _)) ->
      ty_eq ctxt tva tvb
      >>? (fun (Eq, ctxt) -> ok Eq ctxt 1)
      |> record_inconsistent ctxt ta tb
  | (List_t (tva, _, _), List_t (tvb, _, _)) ->
      ty_eq ctxt tva tvb
      >>? (fun (Eq, ctxt) -> ok Eq ctxt 1)
      |> record_inconsistent ctxt ta tb
  | (_, _) ->
      serialize_ty_for_error ctxt ta
      >>? fun (ta, ctxt) ->
      serialize_ty_for_error ctxt tb
      >>? fun (tb, _ctxt) -> error (Inconsistent_types (ta, tb))

let rec stack_ty_eq :
    type ta tb.
    context ->
    int ->
    ta stack_ty ->
    tb stack_ty ->
    ((ta stack_ty, tb stack_ty) eq * context) tzresult =
 fun ctxt lvl ta tb ->
  match (ta, tb) with
  | (Item_t (tva, ra, _), Item_t (tvb, rb, _)) ->
      ty_eq ctxt tva tvb
      |> record_trace (Bad_stack_item lvl)
      >>? fun (Eq, ctxt) ->
      stack_ty_eq ctxt (lvl + 1) ra rb
      >>? fun (Eq, ctxt) ->
      (Ok (Eq, ctxt) : ((ta stack_ty, tb stack_ty) eq * context) tzresult)
  | (Empty_t, Empty_t) ->
      Ok (Eq, ctxt)
  | (_, _) ->
      error Bad_stack_length

let merge_comparable_types :
    type ta.
    legacy:bool ->
    ta comparable_ty ->
    ta comparable_ty ->
    ta comparable_ty tzresult =
 fun ~legacy ta tb ->
  match (ta, tb) with
  | (Int_key annot_a, Int_key annot_b) ->
      merge_type_annot ~legacy annot_a annot_b >|? fun annot -> Int_key annot
  | (Nat_key annot_a, Nat_key annot_b) ->
      merge_type_annot ~legacy annot_a annot_b >|? fun annot -> Nat_key annot
  | (String_key annot_a, String_key annot_b) ->
      merge_type_annot ~legacy annot_a annot_b
      >|? fun annot -> String_key annot
  | (Bytes_key annot_a, Bytes_key annot_b) ->
      merge_type_annot ~legacy annot_a annot_b >|? fun annot -> Bytes_key annot
  | (Mutez_key annot_a, Mutez_key annot_b) ->
      merge_type_annot ~legacy annot_a annot_b >|? fun annot -> Mutez_key annot
  | (Bool_key annot_a, Bool_key annot_b) ->
      merge_type_annot ~legacy annot_a annot_b >|? fun annot -> Bool_key annot
  | (Key_hash_key annot_a, Key_hash_key annot_b) ->
      merge_type_annot ~legacy annot_a annot_b
      >|? fun annot -> Key_hash_key annot
  | (Timestamp_key annot_a, Timestamp_key annot_b) ->
      merge_type_annot ~legacy annot_a annot_b
      >|? fun annot -> Timestamp_key annot
  | (Address_key annot_a, Address_key annot_b) ->
      merge_type_annot ~legacy annot_a annot_b
      >|? fun annot -> Address_key annot
  | (_, _) ->
      assert false

(* FIXME: fix injectivity of some types *)

let merge_types :
    type b.
    legacy:bool ->
    context ->
    Script.location ->
    b ty ->
    b ty ->
    (b ty * context) tzresult =
 fun ~legacy ->
  let rec help : type a. context -> a ty -> a ty -> (a ty * context) tzresult =
   fun ctxt ty1 ty2 ->
    match (ty1, ty2) with
    | (Unit_t tn1, Unit_t tn2) ->
        merge_type_annot ~legacy tn1 tn2 >|? fun tname -> (Unit_t tname, ctxt)
    | (Int_t tn1, Int_t tn2) ->
        merge_type_annot ~legacy tn1 tn2 >|? fun tname -> (Int_t tname, ctxt)
    | (Nat_t tn1, Nat_t tn2) ->
        merge_type_annot ~legacy tn1 tn2 >|? fun tname -> (Nat_t tname, ctxt)
    | (Key_t tn1, Key_t tn2) ->
        merge_type_annot ~legacy tn1 tn2 >|? fun tname -> (Key_t tname, ctxt)
    | (Key_hash_t tn1, Key_hash_t tn2) ->
        merge_type_annot ~legacy tn1 tn2
        >|? fun tname -> (Key_hash_t tname, ctxt)
    | (String_t tn1, String_t tn2) ->
        merge_type_annot ~legacy tn1 tn2 >|? fun tname -> (String_t tname, ctxt)
    | (Bytes_t tn1, Bytes_t tn2) ->
        merge_type_annot ~legacy tn1 tn2 >|? fun tname -> (Bytes_t tname, ctxt)
    | (Signature_t tn1, Signature_t tn2) ->
        merge_type_annot ~legacy tn1 tn2
        >|? fun tname -> (Signature_t tname, ctxt)
    | (Mutez_t tn1, Mutez_t tn2) ->
        merge_type_annot ~legacy tn1 tn2 >|? fun tname -> (Mutez_t tname, ctxt)
    | (Timestamp_t tn1, Timestamp_t tn2) ->
        merge_type_annot ~legacy tn1 tn2
        >|? fun tname -> (Timestamp_t tname, ctxt)
    | (Address_t tn1, Address_t tn2) ->
        merge_type_annot ~legacy tn1 tn2
        >|? fun tname -> (Address_t tname, ctxt)
    | (Bool_t tn1, Bool_t tn2) ->
        merge_type_annot ~legacy tn1 tn2 >|? fun tname -> (Bool_t tname, ctxt)
    | (Chain_id_t tn1, Chain_id_t tn2) ->
        merge_type_annot ~legacy tn1 tn2
        >|? fun tname -> (Chain_id_t tname, ctxt)
    | (Operation_t tn1, Operation_t tn2) ->
        merge_type_annot ~legacy tn1 tn2
        >|? fun tname -> (Operation_t tname, ctxt)
    | (Map_t (tal, tar, tn1, has_big_map), Map_t (tbl, tbr, tn2, _)) ->
        merge_type_annot ~legacy tn1 tn2
        >>? fun tname ->
        help ctxt tar tbr
        >>? fun (value, ctxt) ->
        ty_eq ctxt tar value
        >>? fun (Eq, ctxt) ->
        merge_comparable_types ~legacy tal tbl
        >|? fun tk -> (Map_t (tk, value, tname, has_big_map), ctxt)
    | (Big_map_t (tal, tar, tn1), Big_map_t (tbl, tbr, tn2)) ->
        merge_type_annot ~legacy tn1 tn2
        >>? fun tname ->
        help ctxt tar tbr
        >>? fun (value, ctxt) ->
        ty_eq ctxt tar value
        >>? fun (Eq, ctxt) ->
        merge_comparable_types ~legacy tal tbl
        >|? fun tk -> (Big_map_t (tk, value, tname), ctxt)
    | (Set_t (ea, tn1), Set_t (eb, tn2)) ->
        merge_type_annot ~legacy tn1 tn2
        >>? fun tname ->
        merge_comparable_types ~legacy ea eb
        >|? fun e -> (Set_t (e, tname), ctxt)
    | ( Pair_t
          ((tal, l_field1, l_var1), (tar, r_field1, r_var1), tn1, has_big_map),
        Pair_t ((tbl, l_field2, l_var2), (tbr, r_field2, r_var2), tn2, _) ) ->
        merge_type_annot ~legacy tn1 tn2
        >>? fun tname ->
        merge_field_annot ~legacy l_field1 l_field2
        >>? fun l_field ->
        merge_field_annot ~legacy r_field1 r_field2
        >>? fun r_field ->
        let l_var = merge_var_annot l_var1 l_var2 in
        let r_var = merge_var_annot r_var1 r_var2 in
        help ctxt tal tbl
        >>? fun (left_ty, ctxt) ->
        help ctxt tar tbr
        >|? fun (right_ty, ctxt) ->
        ( Pair_t
            ( (left_ty, l_field, l_var),
              (right_ty, r_field, r_var),
              tname,
              has_big_map ),
          ctxt )
    | ( Union_t ((tal, tal_annot), (tar, tar_annot), tn1, has_big_map),
        Union_t ((tbl, tbl_annot), (tbr, tbr_annot), tn2, _) ) ->
        merge_type_annot ~legacy tn1 tn2
        >>? fun tname ->
        merge_field_annot ~legacy tal_annot tbl_annot
        >>? fun left_annot ->
        merge_field_annot ~legacy tar_annot tbr_annot
        >>? fun right_annot ->
        help ctxt tal tbl
        >>? fun (left_ty, ctxt) ->
        help ctxt tar tbr
        >|? fun (right_ty, ctxt) ->
        ( Union_t
            ((left_ty, left_annot), (right_ty, right_annot), tname, has_big_map),
          ctxt )
    | (Lambda_t (tal, tar, tn1), Lambda_t (tbl, tbr, tn2)) ->
        merge_type_annot ~legacy tn1 tn2
        >>? fun tname ->
        help ctxt tal tbl
        >>? fun (left_ty, ctxt) ->
        help ctxt tar tbr
        >|? fun (right_ty, ctxt) -> (Lambda_t (left_ty, right_ty, tname), ctxt)
    | (Contract_t (tal, tn1), Contract_t (tbl, tn2)) ->
        merge_type_annot ~legacy tn1 tn2
        >>? fun tname ->
        help ctxt tal tbl
        >|? fun (arg_ty, ctxt) -> (Contract_t (arg_ty, tname), ctxt)
    | (Option_t (tva, tn1, has_big_map), Option_t (tvb, tn2, _)) ->
        merge_type_annot ~legacy tn1 tn2
        >>? fun tname ->
        help ctxt tva tvb
        >|? fun (ty, ctxt) -> (Option_t (ty, tname, has_big_map), ctxt)
    | (List_t (tva, tn1, has_big_map), List_t (tvb, tn2, _)) ->
        merge_type_annot ~legacy tn1 tn2
        >>? fun tname ->
        help ctxt tva tvb
        >|? fun (ty, ctxt) -> (List_t (ty, tname, has_big_map), ctxt)
    | (_, _) ->
        assert false
  in
  fun ctxt loc ty1 ty2 ->
    record_inconsistent_type_annotations ctxt loc ty1 ty2 (help ctxt ty1 ty2)

let merge_stacks :
    type ta.
    legacy:bool ->
    Script.location ->
    context ->
    ta stack_ty ->
    ta stack_ty ->
    (ta stack_ty * context) tzresult =
 fun ~legacy loc ->
  let rec help :
      type a.
      context -> a stack_ty -> a stack_ty -> (a stack_ty * context) tzresult =
   fun ctxt stack1 stack2 ->
    match (stack1, stack2) with
    | (Empty_t, Empty_t) ->
        ok (Empty_t, ctxt)
    | (Item_t (ty1, rest1, annot1), Item_t (ty2, rest2, annot2)) ->
        let annot = merge_var_annot annot1 annot2 in
        merge_types ~legacy ctxt loc ty1 ty2
        >>? fun (ty, ctxt) ->
        help ctxt rest1 rest2
        >|? fun (rest, ctxt) -> (Item_t (ty, rest, annot), ctxt)
  in
  help

let has_big_map : type t. t ty -> bool = function
  | Unit_t _ ->
      false
  | Int_t _ ->
      false
  | Nat_t _ ->
      false
  | Signature_t _ ->
      false
  | String_t _ ->
      false
  | Bytes_t _ ->
      false
  | Mutez_t _ ->
      false
  | Key_hash_t _ ->
      false
  | Key_t _ ->
      false
  | Timestamp_t _ ->
      false
  | Address_t _ ->
      false
  | Bool_t _ ->
      false
  | Lambda_t (_, _, _) ->
      false
  | Set_t (_, _) ->
      false
  | Big_map_t (_, _, _) ->
      true
  | Contract_t (_, _) ->
      false
  | Operation_t _ ->
      false
  | Chain_id_t _ ->
      false
  | Pair_t (_, _, _, has_big_map) ->
      has_big_map
  | Union_t (_, _, _, has_big_map) ->
      has_big_map
  | Option_t (_, _, has_big_map) ->
      has_big_map
  | List_t (_, _, has_big_map) ->
      has_big_map
  | Map_t (_, _, _, has_big_map) ->
      has_big_map

(* ---- Type checker results -------------------------------------------------*)

type 'bef judgement =
  | Typed : ('bef, 'aft) descr -> 'bef judgement
  | Failed : {
      descr : 'aft. 'aft stack_ty -> ('bef, 'aft) descr;
    }
      -> 'bef judgement

(* ---- Type checker (Untyped expressions -> Typed IR) ----------------------*)

type ('t, 'f, 'b) branch = {
  branch : 'r. ('t, 'r) descr -> ('f, 'r) descr -> ('b, 'r) descr;
}
[@@unboxed]

let merge_branches :
    type bef a b.
    legacy:bool ->
    context ->
    int ->
    a judgement ->
    b judgement ->
    (a, b, bef) branch ->
    (bef judgement * context) tzresult Lwt.t =
 fun ~legacy ctxt loc btr bfr {branch} ->
  match (btr, bfr) with
  | (Typed ({aft = aftbt; _} as dbt), Typed ({aft = aftbf; _} as dbf)) ->
      let unmatched_branches () =
        serialize_stack_for_error ctxt aftbt
        >>=? fun (aftbt, ctxt) ->
        serialize_stack_for_error ctxt aftbf
        >>|? fun (aftbf, _ctxt) -> Unmatched_branches (loc, aftbt, aftbf)
      in
      trace_eval
        unmatched_branches
        ( Lwt.return (stack_ty_eq ctxt 1 aftbt aftbf)
        >>=? fun (Eq, ctxt) ->
        Lwt.return (merge_stacks ~legacy loc ctxt aftbt aftbf)
        >>=? fun (merged_stack, ctxt) ->
        return
          ( Typed
              (branch
                 {dbt with aft = merged_stack}
                 {dbf with aft = merged_stack}),
            ctxt ) )
  | (Failed {descr = descrt}, Failed {descr = descrf}) ->
      let descr ret = branch (descrt ret) (descrf ret) in
      return (Failed {descr}, ctxt)
  | (Typed dbt, Failed {descr = descrf}) ->
      return (Typed (branch dbt (descrf dbt.aft)), ctxt)
  | (Failed {descr = descrt}, Typed dbf) ->
      return (Typed (branch (descrt dbf.aft) dbf), ctxt)

let rec parse_comparable_ty :
    context -> Script.node -> (ex_comparable_ty * context) tzresult =
 fun ctxt ty ->
  Gas.consume ctxt Typecheck_costs.cycle
  >>? fun ctxt ->
  Gas.consume ctxt (Typecheck_costs.type_ 0)
  >>? fun ctxt ->
  match ty with
  | Prim (loc, T_int, [], annot) ->
      parse_type_annot loc annot
      >|? fun tname -> (Ex_comparable_ty (Int_key tname), ctxt)
  | Prim (loc, T_nat, [], annot) ->
      parse_type_annot loc annot
      >|? fun tname -> (Ex_comparable_ty (Nat_key tname), ctxt)
  | Prim (loc, T_string, [], annot) ->
      parse_type_annot loc annot
      >|? fun tname -> (Ex_comparable_ty (String_key tname), ctxt)
  | Prim (loc, T_bytes, [], annot) ->
      parse_type_annot loc annot
      >|? fun tname -> (Ex_comparable_ty (Bytes_key tname), ctxt)
  | Prim (loc, T_mutez, [], annot) ->
      parse_type_annot loc annot
      >|? fun tname -> (Ex_comparable_ty (Mutez_key tname), ctxt)
  | Prim (loc, T_bool, [], annot) ->
      parse_type_annot loc annot
      >|? fun tname -> (Ex_comparable_ty (Bool_key tname), ctxt)
  | Prim (loc, T_key_hash, [], annot) ->
      parse_type_annot loc annot
      >|? fun tname -> (Ex_comparable_ty (Key_hash_key tname), ctxt)
  | Prim (loc, T_timestamp, [], annot) ->
      parse_type_annot loc annot
      >|? fun tname -> (Ex_comparable_ty (Timestamp_key tname), ctxt)
  | Prim (loc, T_address, [], annot) ->
      parse_type_annot loc annot
      >|? fun tname -> (Ex_comparable_ty (Address_key tname), ctxt)
  | Prim
      ( loc,
        ( ( T_int
          | T_nat
          | T_string
          | T_mutez
          | T_bool
          | T_key
          | T_address
          | T_timestamp ) as prim ),
        l,
        _ ) ->
      error (Invalid_arity (loc, prim, 0, List.length l))
  | Prim
      ( loc,
        ( T_pair
        | T_or
        | T_set
        | T_map
        | T_list
        | T_option
        | T_lambda
        | T_unit
        | T_signature
        | T_contract ),
        _,
        _ ) ->
      error (Comparable_type_expected (loc, Micheline.strip_locations ty))
  | expr ->
      error
      @@ unexpected
           expr
           []
           Type_namespace
           [ T_int;
             T_nat;
             T_string;
             T_mutez;
             T_bool;
             T_key;
             T_key_hash;
             T_timestamp ]

and parse_packable_ty :
    context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult =
 fun ctxt ~legacy ->
  parse_ty
    ctxt
    ~legacy
    ~allow_big_map:false
    ~allow_operation:false
    ~allow_contract:legacy

and parse_parameter_ty :
    context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult =
 fun ctxt ~legacy ->
  parse_ty
    ctxt
    ~legacy
    ~allow_big_map:true
    ~allow_operation:false
    ~allow_contract:true

and parse_any_ty :
    context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult =
 fun ctxt ~legacy ->
  parse_ty
    ctxt
    ~legacy
    ~allow_big_map:true
    ~allow_operation:true
    ~allow_contract:true

and parse_ty :
    context ->
    legacy:bool ->
    allow_big_map:bool ->
    allow_operation:bool ->
    allow_contract:bool ->
    Script.node ->
    (ex_ty * context) tzresult =
 fun ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract node ->
  Gas.consume ctxt Typecheck_costs.cycle
  >>? fun ctxt ->
  match node with
  | Prim (loc, T_unit, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Unit_t ty_name), ctxt)
  | Prim (loc, T_int, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Int_t ty_name), ctxt)
  | Prim (loc, T_nat, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Nat_t ty_name), ctxt)
  | Prim (loc, T_string, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (String_t ty_name), ctxt)
  | Prim (loc, T_bytes, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Bytes_t ty_name), ctxt)
  | Prim (loc, T_mutez, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Mutez_t ty_name), ctxt)
  | Prim (loc, T_bool, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Bool_t ty_name), ctxt)
  | Prim (loc, T_key, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Key_t ty_name), ctxt)
  | Prim (loc, T_key_hash, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Key_hash_t ty_name), ctxt)
  | Prim (loc, T_timestamp, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Timestamp_t ty_name), ctxt)
  | Prim (loc, T_address, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Address_t ty_name), ctxt)
  | Prim (loc, T_signature, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Signature_t ty_name), ctxt)
  | Prim (loc, T_operation, [], annot) ->
      if allow_operation then
        parse_type_annot loc annot
        >>? fun ty_name ->
        Gas.consume ctxt (Typecheck_costs.type_ 0)
        >|? fun ctxt -> (Ex_ty (Operation_t ty_name), ctxt)
      else error (Unexpected_operation loc)
  | Prim (loc, T_chain_id, [], annot) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 0)
      >|? fun ctxt -> (Ex_ty (Chain_id_t ty_name), ctxt)
  | Prim (loc, T_contract, [utl], annot) ->
      if allow_contract then
        parse_parameter_ty ctxt ~legacy utl
        >>? fun (Ex_ty tl, ctxt) ->
        parse_type_annot loc annot
        >>? fun ty_name ->
        Gas.consume ctxt (Typecheck_costs.type_ 1)
        >|? fun ctxt -> (Ex_ty (Contract_t (tl, ty_name)), ctxt)
      else error (Unexpected_contract loc)
  | Prim (loc, T_pair, [utl; utr], annot) ->
      extract_field_annot utl
      >>? fun (utl, left_field) ->
      extract_field_annot utr
      >>? fun (utr, right_field) ->
      parse_ty ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract utl
      >>? fun (Ex_ty tl, ctxt) ->
      parse_ty ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract utr
      >>? fun (Ex_ty tr, ctxt) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 2)
      >|? fun ctxt ->
      ( Ex_ty
          (Pair_t
             ( (tl, left_field, None),
               (tr, right_field, None),
               ty_name,
               has_big_map tl || has_big_map tr )),
        ctxt )
  | Prim (loc, T_or, [utl; utr], annot) ->
      extract_field_annot utl
      >>? fun (utl, left_constr) ->
      extract_field_annot utr
      >>? fun (utr, right_constr) ->
      parse_ty ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract utl
      >>? fun (Ex_ty tl, ctxt) ->
      parse_ty ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract utr
      >>? fun (Ex_ty tr, ctxt) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 2)
      >|? fun ctxt ->
      ( Ex_ty
          (Union_t
             ( (tl, left_constr),
               (tr, right_constr),
               ty_name,
               has_big_map tl || has_big_map tr )),
        ctxt )
  | Prim (loc, T_lambda, [uta; utr], annot) ->
      parse_any_ty ctxt ~legacy uta
      >>? fun (Ex_ty ta, ctxt) ->
      parse_any_ty ctxt ~legacy utr
      >>? fun (Ex_ty tr, ctxt) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 2)
      >|? fun ctxt -> (Ex_ty (Lambda_t (ta, tr, ty_name)), ctxt)
  | Prim (loc, T_option, [ut], annot) ->
      ( if legacy then
        (* legacy semantics with (broken) field annotations *)
        extract_field_annot ut
        >>? fun (ut, _some_constr) ->
        parse_composed_type_annot loc annot
        >>? fun (ty_name, _none_constr, _) -> ok (ut, ty_name)
      else parse_type_annot loc annot >>? fun ty_name -> ok (ut, ty_name) )
      >>? fun (ut, ty_name) ->
      parse_ty ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract ut
      >>? fun (Ex_ty t, ctxt) ->
      Gas.consume ctxt (Typecheck_costs.type_ 2)
      >|? fun ctxt -> (Ex_ty (Option_t (t, ty_name, has_big_map t)), ctxt)
  | Prim (loc, T_list, [ut], annot) ->
      parse_ty ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract ut
      >>? fun (Ex_ty t, ctxt) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 1)
      >|? fun ctxt -> (Ex_ty (List_t (t, ty_name, has_big_map t)), ctxt)
  | Prim (loc, T_set, [ut], annot) ->
      parse_comparable_ty ctxt ut
      >>? fun (Ex_comparable_ty t, ctxt) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 1)
      >|? fun ctxt -> (Ex_ty (Set_t (t, ty_name)), ctxt)
  | Prim (loc, T_map, [uta; utr], annot) ->
      parse_comparable_ty ctxt uta
      >>? fun (Ex_comparable_ty ta, ctxt) ->
      parse_ty ctxt ~legacy ~allow_big_map ~allow_operation ~allow_contract utr
      >>? fun (Ex_ty tr, ctxt) ->
      parse_type_annot loc annot
      >>? fun ty_name ->
      Gas.consume ctxt (Typecheck_costs.type_ 2)
      >|? fun ctxt -> (Ex_ty (Map_t (ta, tr, ty_name, has_big_map tr)), ctxt)
  | Prim (loc, T_big_map, args, annot) when allow_big_map ->
      parse_big_map_ty ctxt ~legacy loc args annot
      >>? fun (big_map_ty, ctxt) ->
      Gas.consume ctxt (Typecheck_costs.type_ 2)
      >|? fun ctxt -> (big_map_ty, ctxt)
  | Prim (loc, T_big_map, _, _) ->
      error (Unexpected_big_map loc)
  | Prim
      ( loc,
        ( ( T_unit
          | T_signature
          | T_int
          | T_nat
          | T_string
          | T_bytes
          | T_mutez
          | T_bool
          | T_key
          | T_key_hash
          | T_timestamp
          | T_address ) as prim ),
        l,
        _ ) ->
      error (Invalid_arity (loc, prim, 0, List.length l))
  | Prim (loc, ((T_set | T_list | T_option | T_contract) as prim), l, _) ->
      error (Invalid_arity (loc, prim, 1, List.length l))
  | Prim (loc, ((T_pair | T_or | T_map | T_lambda) as prim), l, _) ->
      error (Invalid_arity (loc, prim, 2, List.length l))
  | expr ->
      error
      @@ unexpected
           expr
           []
           Type_namespace
           [ T_pair;
             T_or;
             T_set;
             T_map;
             T_list;
             T_option;
             T_lambda;
             T_unit;
             T_signature;
             T_contract;
             T_int;
             T_nat;
             T_operation;
             T_string;
             T_bytes;
             T_mutez;
             T_bool;
             T_key;
             T_key_hash;
             T_timestamp;
             T_chain_id ]

and parse_big_map_ty ctxt ~legacy big_map_loc args map_annot =
  Gas.consume ctxt Typecheck_costs.cycle
  >>? fun ctxt ->
  match args with
  | [key_ty; value_ty] ->
      parse_comparable_ty ctxt key_ty
      >>? fun (Ex_comparable_ty key_ty, ctxt) ->
      parse_packable_ty ctxt ~legacy value_ty
      >>? fun (Ex_ty value_ty, ctxt) ->
      parse_type_annot big_map_loc map_annot
      >|? fun map_name ->
      let big_map_ty = Big_map_t (key_ty, value_ty, map_name) in
      (Ex_ty big_map_ty, ctxt)
  | args ->
      error @@ Invalid_arity (big_map_loc, T_big_map, 2, List.length args)

and parse_storage_ty :
    context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult =
 fun ctxt ~legacy node ->
  match node with
  | Prim
      ( loc,
        T_pair,
        [Prim (big_map_loc, T_big_map, args, map_annot); remaining_storage],
        storage_annot )
    when legacy -> (
    match storage_annot with
    | [] ->
        parse_ty
          ctxt
          ~legacy
          ~allow_big_map:true
          ~allow_operation:false
          ~allow_contract:legacy
          node
    | [single]
      when Compare.Int.(String.length single > 0)
           && Compare.Char.(single.[0] = '%') ->
        parse_ty
          ctxt
          ~legacy
          ~allow_big_map:true
          ~allow_operation:false
          ~allow_contract:legacy
          node
    | _ ->
        (* legacy semantics of big maps used the wrong annotation parser *)
        Gas.consume ctxt Typecheck_costs.cycle
        >>? fun ctxt ->
        parse_big_map_ty ctxt ~legacy big_map_loc args map_annot
        >>? fun (Ex_ty big_map_ty, ctxt) ->
        parse_ty
          ctxt
          ~legacy
          ~allow_big_map:true
          ~allow_operation:false
          ~allow_contract:legacy
          remaining_storage
        >>? fun (Ex_ty remaining_storage, ctxt) ->
        parse_composed_type_annot loc storage_annot
        >>? fun (ty_name, map_field, storage_field) ->
        Gas.consume ctxt (Typecheck_costs.type_ 5)
        >|? fun ctxt ->
        ( Ex_ty
            (Pair_t
               ( (big_map_ty, map_field, None),
                 (remaining_storage, storage_field, None),
                 ty_name,
                 true )),
          ctxt ) )
  | _ ->
      parse_ty
        ctxt
        ~legacy
        ~allow_big_map:true
        ~allow_operation:false
        ~allow_contract:legacy
        node

let check_packable ~legacy loc root =
  let rec check : type t. t ty -> unit tzresult = function
    | Big_map_t _ ->
        error (Unexpected_big_map loc)
    | Operation_t _ ->
        error (Unexpected_operation loc)
    | Unit_t _ ->
        ok ()
    | Int_t _ ->
        ok ()
    | Nat_t _ ->
        ok ()
    | Signature_t _ ->
        ok ()
    | String_t _ ->
        ok ()
    | Bytes_t _ ->
        ok ()
    | Mutez_t _ ->
        ok ()
    | Key_hash_t _ ->
        ok ()
    | Key_t _ ->
        ok ()
    | Timestamp_t _ ->
        ok ()
    | Address_t _ ->
        ok ()
    | Bool_t _ ->
        ok ()
    | Chain_id_t _ ->
        ok ()
    | Pair_t ((l_ty, _, _), (r_ty, _, _), _, _) ->
        check l_ty >>? fun () -> check r_ty
    | Union_t ((l_ty, _), (r_ty, _), _, _) ->
        check l_ty >>? fun () -> check r_ty
    | Option_t (v_ty, _, _) ->
        check v_ty
    | List_t (elt_ty, _, _) ->
        check elt_ty
    | Set_t (_, _) ->
        ok ()
    | Map_t (_, elt_ty, _, _) ->
        check elt_ty
    | Lambda_t (_l_ty, _r_ty, _) ->
        ok ()
    | Contract_t (_, _) when legacy ->
        ok ()
    | Contract_t (_, _) ->
        error (Unexpected_contract loc)
  in
  check root

type ex_script = Ex_script : ('a, 'c) script -> ex_script

type _ dig_proof_argument =
  | Dig_proof_argument :
      ( ('x * 'rest, 'rest, 'bef, 'aft) stack_prefix_preservation_witness
      * ('x ty * var_annot option)
      * 'aft stack_ty )
      -> 'bef dig_proof_argument

type (_, _) dug_proof_argument =
  | Dug_proof_argument :
      ( ('rest, 'x * 'rest, 'bef, 'aft) stack_prefix_preservation_witness
      * unit
      * 'aft stack_ty )
      -> ('bef, 'x) dug_proof_argument

type _ dipn_proof_argument =
  | Dipn_proof_argument :
      ( ('fbef, 'faft, 'bef, 'aft) stack_prefix_preservation_witness
      * (context * ('fbef, 'faft) descr)
      * 'aft stack_ty )
      -> 'bef dipn_proof_argument

type _ dropn_proof_argument =
  | Dropn_proof_argument :
      ( ('rest, 'rest, 'bef, 'aft) stack_prefix_preservation_witness
      * 'rest stack_ty
      * 'aft stack_ty )
      -> 'bef dropn_proof_argument

(* Lwt versions *)
let parse_var_annot loc ?default annot =
  Lwt.return (parse_var_annot loc ?default annot)

let parse_entrypoint_annot loc ?default annot =
  Lwt.return (parse_entrypoint_annot loc ?default annot)

let parse_constr_annot loc ?if_special_first ?if_special_second annot =
  Lwt.return
    (parse_constr_annot loc ?if_special_first ?if_special_second annot)

let parse_two_var_annot loc annot = Lwt.return (parse_two_var_annot loc annot)

let parse_destr_annot loc annot ~default_accessor ~field_name ~pair_annot
    ~value_annot =
  Lwt.return
    (parse_destr_annot
       loc
       annot
       ~default_accessor
       ~field_name
       ~pair_annot
       ~value_annot)

let parse_var_type_annot loc annot =
  Lwt.return (parse_var_type_annot loc annot)

let find_entrypoint (type full) (full : full ty) ~root_name entrypoint =
  let rec find_entrypoint :
      type t. t ty -> string -> (Script.node -> Script.node) * ex_ty =
   fun t entrypoint ->
    match t with
    | Union_t ((tl, al), (tr, ar), _, _) -> (
        if
          match al with
          | None ->
              false
          | Some (`Field_annot l) ->
              Compare.String.(l = entrypoint)
        then ((fun e -> Prim (0, D_Left, [e], [])), Ex_ty tl)
        else if
          match ar with
          | None ->
              false
          | Some (`Field_annot r) ->
              Compare.String.(r = entrypoint)
        then ((fun e -> Prim (0, D_Right, [e], [])), Ex_ty tr)
        else
          try
            let (f, t) = find_entrypoint tl entrypoint in
            ((fun e -> Prim (0, D_Left, [f e], [])), t)
          with Not_found ->
            let (f, t) = find_entrypoint tr entrypoint in
            ((fun e -> Prim (0, D_Right, [f e], [])), t) )
    | _ ->
        raise Not_found
  in
  let entrypoint =
    if Compare.String.(entrypoint = "") then "default" else entrypoint
  in
  if Compare.Int.(String.length entrypoint > 31) then
    error (Entrypoint_name_too_long entrypoint)
  else
    match root_name with
    | Some root_name when Compare.String.(entrypoint = root_name) ->
        ok ((fun e -> e), Ex_ty full)
    | _ -> (
      try ok (find_entrypoint full entrypoint)
      with Not_found -> (
        match entrypoint with
        | "default" ->
            ok ((fun e -> e), Ex_ty full)
        | _ ->
            error (No_such_entrypoint entrypoint) ) )

let find_entrypoint_for_type (type full exp) ~(full : full ty)
    ~(expected : exp ty) ~root_name entrypoint ctxt :
    (context * string * exp ty) tzresult =
  match (entrypoint, root_name) with
  | ("default", Some "root") -> (
    match find_entrypoint full ~root_name entrypoint with
    | Error _ as err ->
        err
    | Ok (_, Ex_ty ty) -> (
      match ty_eq ctxt expected ty with
      | Ok (Eq, ctxt) ->
          ok (ctxt, "default", (ty : exp ty))
      | Error _ ->
          ty_eq ctxt expected full
          >>? fun (Eq, ctxt) -> ok (ctxt, "root", (full : exp ty)) ) )
  | _ ->
      find_entrypoint full ~root_name entrypoint
      >>? fun (_, Ex_ty ty) ->
      ty_eq ctxt expected ty
      >>? fun (Eq, ctxt) -> ok (ctxt, entrypoint, (ty : exp ty))

module Entrypoints = Set.Make (String)

exception Duplicate of string

exception Too_long of string

let well_formed_entrypoints (type full) (full : full ty) ~root_name =
  let merge path annot (type t) (ty : t ty) reachable
      ((first_unreachable, all) as acc) =
    match annot with
    | None | Some (`Field_annot "") -> (
        if reachable then acc
        else
          match ty with
          | Union_t _ ->
              acc
          | _ -> (
            match first_unreachable with
            | None ->
                (Some (List.rev path), all)
            | Some _ ->
                acc ) )
    | Some (`Field_annot name) ->
        if Compare.Int.(String.length name > 31) then raise (Too_long name)
        else if Entrypoints.mem name all then raise (Duplicate name)
        else (first_unreachable, Entrypoints.add name all)
  in
  let rec check :
      type t.
      t ty ->
      prim list ->
      bool ->
      prim list option * Entrypoints.t ->
      prim list option * Entrypoints.t =
   fun t path reachable acc ->
    match t with
    | Union_t ((tl, al), (tr, ar), _, _) ->
        let acc = merge (D_Left :: path) al tl reachable acc in
        let acc = merge (D_Right :: path) ar tr reachable acc in
        let acc =
          check
            tl
            (D_Left :: path)
            (match al with Some _ -> true | None -> reachable)
            acc
        in
        check
          tr
          (D_Right :: path)
          (match ar with Some _ -> true | None -> reachable)
          acc
    | _ ->
        acc
  in
  try
    let (init, reachable) =
      match root_name with
      | None | Some "" ->
          (Entrypoints.empty, false)
      | Some name ->
          (Entrypoints.singleton name, true)
    in
    let (first_unreachable, all) = check full [] reachable (None, init) in
    if not (Entrypoints.mem "default" all) then ok ()
    else
      match first_unreachable with
      | None ->
          ok ()
      | Some path ->
          error (Unreachable_entrypoint path)
  with
  | Duplicate name ->
      error (Duplicate_entrypoint name)
  | Too_long name ->
      error (Entrypoint_name_too_long name)

let rec parse_data :
    type a.
    ?type_logger:type_logger ->
    context ->
    legacy:bool ->
    a ty ->
    Script.node ->
    (a * context) tzresult Lwt.t =
 fun ?type_logger ctxt ~legacy ty script_data ->
  Lwt.return (Gas.consume ctxt Typecheck_costs.cycle)
  >>=? fun ctxt ->
  let error () =
    Lwt.return (serialize_ty_for_error ctxt ty)
    >>|? fun (ty, _ctxt) ->
    Invalid_constant (location script_data, strip_locations script_data, ty)
  in
  let traced body = trace_eval error body in
  let parse_items ?type_logger loc ctxt expr key_type value_type items
      item_wrapper =
    let length = List.length items in
    fold_left_s
      (fun (last_value, map, ctxt) item ->
        Lwt.return (Gas.consume ctxt (Typecheck_costs.map_element length))
        >>=? fun ctxt ->
        match item with
        | Prim (_, D_Elt, [k; v], _) ->
            parse_comparable_data ?type_logger ctxt key_type k
            >>=? fun (k, ctxt) ->
            parse_data ?type_logger ctxt ~legacy value_type v
            >>=? fun (v, ctxt) ->
            ( match last_value with
            | Some value ->
                if Compare.Int.(0 <= compare_comparable key_type value k) then
                  if Compare.Int.(0 = compare_comparable key_type value k) then
                    fail (Duplicate_map_keys (loc, strip_locations expr))
                  else fail (Unordered_map_keys (loc, strip_locations expr))
                else return_unit
            | None ->
                return_unit )
            >>=? fun () ->
            return (Some k, map_update k (Some (item_wrapper v)) map, ctxt)
        | Prim (loc, D_Elt, l, _) ->
            fail @@ Invalid_arity (loc, D_Elt, 2, List.length l)
        | Prim (loc, name, _, _) ->
            fail @@ Invalid_primitive (loc, [D_Elt], name)
        | Int _ | String _ | Bytes _ | Seq _ ->
            error () >>=? fail)
      (None, empty_map key_type, ctxt)
      items
    |> traced
    >>|? fun (_, items, ctxt) -> (items, ctxt)
  in
  match (ty, script_data) with
  (* Unit *)
  | (Unit_t _, Prim (loc, D_Unit, [], annot)) ->
      (if legacy then return () else fail_unexpected_annot loc annot)
      >>=? fun () ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.unit)
      >>|? fun ctxt -> ((() : a), ctxt)
  | (Unit_t _, Prim (loc, D_Unit, l, _)) ->
      traced (fail (Invalid_arity (loc, D_Unit, 0, List.length l)))
  | (Unit_t _, expr) ->
      traced (fail (unexpected expr [] Constant_namespace [D_Unit]))
  (* Booleans *)
  | (Bool_t _, Prim (loc, D_True, [], annot)) ->
      (if legacy then return () else fail_unexpected_annot loc annot)
      >>=? fun () ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.bool)
      >>|? fun ctxt -> (true, ctxt)
  | (Bool_t _, Prim (loc, D_False, [], annot)) ->
      (if legacy then return () else fail_unexpected_annot loc annot)
      >>=? fun () ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.bool)
      >>|? fun ctxt -> (false, ctxt)
  | (Bool_t _, Prim (loc, ((D_True | D_False) as c), l, _)) ->
      traced (fail (Invalid_arity (loc, c, 0, List.length l)))
  | (Bool_t _, expr) ->
      traced (fail (unexpected expr [] Constant_namespace [D_True; D_False]))
  (* Strings *)
  | (String_t _, String (_, v)) ->
      Lwt.return (Gas.consume ctxt (Typecheck_costs.string (String.length v)))
      >>=? fun ctxt ->
      let rec check_printable_ascii i =
        if Compare.Int.(i < 0) then true
        else
          match v.[i] with
          | '\n' | '\x20' .. '\x7E' ->
              check_printable_ascii (i - 1)
          | _ ->
              false
      in
      if check_printable_ascii (String.length v - 1) then return (v, ctxt)
      else error () >>=? fail
  | (String_t _, expr) ->
      traced (fail (Invalid_kind (location expr, [String_kind], kind expr)))
  (* Byte sequences *)
  | (Bytes_t _, Bytes (_, v)) ->
      Lwt.return (Gas.consume ctxt (Typecheck_costs.string (MBytes.length v)))
      >>=? fun ctxt -> return (v, ctxt)
  | (Bytes_t _, expr) ->
      traced (fail (Invalid_kind (location expr, [Bytes_kind], kind expr)))
  (* Integers *)
  | (Int_t _, Int (_, v)) ->
      Lwt.return (Gas.consume ctxt (Typecheck_costs.z v))
      >>=? fun ctxt -> return (Script_int.of_zint v, ctxt)
  | (Nat_t _, Int (_, v)) ->
      Lwt.return (Gas.consume ctxt (Typecheck_costs.z v))
      >>=? fun ctxt ->
      let v = Script_int.of_zint v in
      if Compare.Int.(Script_int.compare v Script_int.zero >= 0) then
        return (Script_int.abs v, ctxt)
      else error () >>=? fail
  | (Int_t _, expr) ->
      traced (fail (Invalid_kind (location expr, [Int_kind], kind expr)))
  | (Nat_t _, expr) ->
      traced (fail (Invalid_kind (location expr, [Int_kind], kind expr)))
  (* Tez amounts *)
  | (Mutez_t _, Int (_, v)) -> (
      Lwt.return
        ( Gas.consume ctxt Typecheck_costs.tez
        >>? fun ctxt ->
        Gas.consume ctxt Michelson_v1_gas.Cost_of.Legacy.z_to_int64 )
      >>=? fun ctxt ->
      try
        match Tez.of_mutez (Z.to_int64 v) with
        | None ->
            raise Exit
        | Some tez ->
            return (tez, ctxt)
      with _ -> error () >>=? fail )
  | (Mutez_t _, expr) ->
      traced (fail (Invalid_kind (location expr, [Int_kind], kind expr)))
  (* Timestamps *)
  | (Timestamp_t _, Int (_, v))
  (* As unparsed with [Optimized] or out of bounds [Readable]. *) ->
      Lwt.return (Gas.consume ctxt (Typecheck_costs.z v))
      >>=? fun ctxt -> return (Script_timestamp.of_zint v, ctxt)
  | (Timestamp_t _, String (_, s)) (* As unparsed with [Redable]. *) -> (
      Lwt.return (Gas.consume ctxt Typecheck_costs.string_timestamp)
      >>=? fun ctxt ->
      match Script_timestamp.of_string s with
      | Some v ->
          return (v, ctxt)
      | None ->
          error () >>=? fail )
  | (Timestamp_t _, expr) ->
      traced
        (fail
           (Invalid_kind (location expr, [String_kind; Int_kind], kind expr)))
  (* IDs *)
  | (Key_t _, Bytes (_, bytes)) -> (
      (* As unparsed with [Optimized]. *)
      Lwt.return (Gas.consume ctxt Typecheck_costs.key)
      >>=? fun ctxt ->
      match
        Data_encoding.Binary.of_bytes Signature.Public_key.encoding bytes
      with
      | Some k ->
          return (k, ctxt)
      | None ->
          error () >>=? fail )
  | (Key_t _, String (_, s)) -> (
      (* As unparsed with [Readable]. *)
      Lwt.return (Gas.consume ctxt Typecheck_costs.key)
      >>=? fun ctxt ->
      match Signature.Public_key.of_b58check_opt s with
      | Some k ->
          return (k, ctxt)
      | None ->
          error () >>=? fail )
  | (Key_t _, expr) ->
      traced
        (fail
           (Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)))
  | (Key_hash_t _, Bytes (_, bytes)) -> (
      (* As unparsed with [Optimized]. *)
      Lwt.return (Gas.consume ctxt Typecheck_costs.key_hash)
      >>=? fun ctxt ->
      match
        Data_encoding.Binary.of_bytes Signature.Public_key_hash.encoding bytes
      with
      | Some k ->
          return (k, ctxt)
      | None ->
          error () >>=? fail )
  | (Key_hash_t _, String (_, s)) (* As unparsed with [Readable]. *) -> (
      Lwt.return (Gas.consume ctxt Typecheck_costs.key_hash)
      >>=? fun ctxt ->
      match Signature.Public_key_hash.of_b58check_opt s with
      | Some k ->
          return (k, ctxt)
      | None ->
          error () >>=? fail )
  | (Key_hash_t _, expr) ->
      traced
        (fail
           (Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)))
  (* Signatures *)
  | (Signature_t _, Bytes (_, bytes)) (* As unparsed with [Optimized]. *) -> (
      Lwt.return (Gas.consume ctxt Typecheck_costs.signature)
      >>=? fun ctxt ->
      match Data_encoding.Binary.of_bytes Signature.encoding bytes with
      | Some k ->
          return (k, ctxt)
      | None ->
          error () >>=? fail )
  | (Signature_t _, String (_, s)) (* As unparsed with [Readable]. *) -> (
      Lwt.return (Gas.consume ctxt Typecheck_costs.signature)
      >>=? fun ctxt ->
      match Signature.of_b58check_opt s with
      | Some s ->
          return (s, ctxt)
      | None ->
          error () >>=? fail )
  | (Signature_t _, expr) ->
      traced
        (fail
           (Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)))
  (* Operations *)
  | (Operation_t _, _) ->
      (* operations cannot appear in parameters or storage,
           the protocol should never parse the bytes of an operation *)
      assert false
  (* Chain_ids *)
  | (Chain_id_t _, Bytes (_, bytes)) -> (
      Lwt.return (Gas.consume ctxt Typecheck_costs.chain_id)
      >>=? fun ctxt ->
      match Data_encoding.Binary.of_bytes Chain_id.encoding bytes with
      | Some k ->
          return (k, ctxt)
      | None ->
          error () >>=? fail )
  | (Chain_id_t _, String (_, s)) -> (
      Lwt.return (Gas.consume ctxt Typecheck_costs.chain_id)
      >>=? fun ctxt ->
      match Chain_id.of_b58check_opt s with
      | Some s ->
          return (s, ctxt)
      | None ->
          error () >>=? fail )
  | (Chain_id_t _, expr) ->
      traced
        (fail
           (Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)))
  (* Addresses *)
  | (Address_t _, Bytes (loc, bytes)) (* As unparsed with [O[ptimized]. *) -> (
      Lwt.return (Gas.consume ctxt Typecheck_costs.contract)
      >>=? fun ctxt ->
      match
        Data_encoding.Binary.of_bytes
          Data_encoding.(tup2 Contract.encoding Variable.string)
          bytes
      with
      | Some (c, entrypoint) ->
          if Compare.Int.(String.length entrypoint > 31) then
            fail (Entrypoint_name_too_long entrypoint)
          else
            ( match entrypoint with
            | "" ->
                return "default"
            | "default" ->
                fail (Unexpected_annotation loc)
            | name ->
                return name )
            >>=? fun entrypoint -> return ((c, entrypoint), ctxt)
      | None ->
          error () >>=? fail )
  | (Address_t _, String (loc, s)) (* As unparsed with [Readable]. *) ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.contract)
      >>=? fun ctxt ->
      ( match String.index_opt s '%' with
      | None ->
          return (s, "default")
      | Some pos -> (
          let len = String.length s - pos - 1 in
          let name = String.sub s (pos + 1) len in
          if Compare.Int.(len > 31) then fail (Entrypoint_name_too_long name)
          else
            match (String.sub s 0 pos, name) with
            | (_, "default") ->
                traced (fail (Unexpected_annotation loc))
            | addr_and_name ->
                return addr_and_name ) )
      >>=? fun (addr, entrypoint) ->
      Lwt.return (Contract.of_b58check addr)
      >>=? fun c -> return ((c, entrypoint), ctxt)
  | (Address_t _, expr) ->
      traced
        (fail
           (Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)))
  (* Contracts *)
  | (Contract_t (ty, _), Bytes (loc, bytes))
  (* As unparsed with [Optimized]. *) -> (
      Lwt.return (Gas.consume ctxt Typecheck_costs.contract)
      >>=? fun ctxt ->
      match
        Data_encoding.Binary.of_bytes
          Data_encoding.(tup2 Contract.encoding Variable.string)
          bytes
      with
      | Some (c, entrypoint) ->
          if Compare.Int.(String.length entrypoint > 31) then
            fail (Entrypoint_name_too_long entrypoint)
          else
            ( match entrypoint with
            | "" ->
                return "default"
            | "default" ->
                traced (fail (Unexpected_annotation loc))
            | name ->
                return name )
            >>=? fun entrypoint ->
            traced (parse_contract ~legacy ctxt loc ty c ~entrypoint)
            >>=? fun (ctxt, _) -> return ((ty, (c, entrypoint)), ctxt)
      | None ->
          error () >>=? fail )
  | (Contract_t (ty, _), String (loc, s)) (* As unparsed with [Readable]. *) ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.contract)
      >>=? fun ctxt ->
      ( match String.index_opt s '%' with
      | None ->
          return (s, "default")
      | Some pos -> (
          let len = String.length s - pos - 1 in
          let name = String.sub s (pos + 1) len in
          if Compare.Int.(len > 31) then fail (Entrypoint_name_too_long name)
          else
            match (String.sub s 0 pos, name) with
            | (_, "default") ->
                traced (fail (Unexpected_annotation loc))
            | addr_and_name ->
                return addr_and_name ) )
      >>=? fun (addr, entrypoint) ->
      traced (Lwt.return (Contract.of_b58check addr))
      >>=? fun c ->
      parse_contract ~legacy ctxt loc ty c ~entrypoint
      >>=? fun (ctxt, _) -> return ((ty, (c, entrypoint)), ctxt)
  | (Contract_t _, expr) ->
      traced
        (fail
           (Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)))
  (* Pairs *)
  | (Pair_t ((ta, _, _), (tb, _, _), _, _), Prim (loc, D_Pair, [va; vb], annot))
    ->
      (if legacy then return () else fail_unexpected_annot loc annot)
      >>=? fun () ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.pair)
      >>=? fun ctxt ->
      traced @@ parse_data ?type_logger ctxt ~legacy ta va
      >>=? fun (va, ctxt) ->
      parse_data ?type_logger ctxt ~legacy tb vb
      >>=? fun (vb, ctxt) -> return ((va, vb), ctxt)
  | (Pair_t _, Prim (loc, D_Pair, l, _)) ->
      fail @@ Invalid_arity (loc, D_Pair, 2, List.length l)
  | (Pair_t _, expr) ->
      traced (fail (unexpected expr [] Constant_namespace [D_Pair]))
  (* Unions *)
  | (Union_t ((tl, _), _, _, _), Prim (loc, D_Left, [v], annot)) ->
      (if legacy then return () else fail_unexpected_annot loc annot)
      >>=? fun () ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.union)
      >>=? fun ctxt ->
      traced @@ parse_data ?type_logger ctxt ~legacy tl v
      >>=? fun (v, ctxt) -> return (L v, ctxt)
  | (Union_t _, Prim (loc, D_Left, l, _)) ->
      fail @@ Invalid_arity (loc, D_Left, 1, List.length l)
  | (Union_t (_, (tr, _), _, _), Prim (loc, D_Right, [v], annot)) ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.union)
      >>=? fun ctxt ->
      traced @@ parse_data ?type_logger ctxt ~legacy tr v
      >>=? fun (v, ctxt) -> return (R v, ctxt)
  | (Union_t _, Prim (loc, D_Right, l, _)) ->
      fail @@ Invalid_arity (loc, D_Right, 1, List.length l)
  | (Union_t _, expr) ->
      traced (fail (unexpected expr [] Constant_namespace [D_Left; D_Right]))
  (* Lambdas *)
  | (Lambda_t (ta, tr, _ty_name), (Seq (_loc, _) as script_instr)) ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.lambda)
      >>=? fun ctxt ->
      traced
      @@ parse_returning
           Lambda
           ?type_logger
           ctxt
           ~legacy
           (ta, Some (`Var_annot "@arg"))
           tr
           script_instr
  | (Lambda_t _, expr) ->
      traced (fail (Invalid_kind (location expr, [Seq_kind], kind expr)))
  (* Options *)
  | (Option_t (t, _, _), Prim (loc, D_Some, [v], annot)) ->
      (if legacy then return () else fail_unexpected_annot loc annot)
      >>=? fun () ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.some)
      >>=? fun ctxt ->
      traced @@ parse_data ?type_logger ctxt ~legacy t v
      >>=? fun (v, ctxt) -> return (Some v, ctxt)
  | (Option_t _, Prim (loc, D_Some, l, _)) ->
      fail @@ Invalid_arity (loc, D_Some, 1, List.length l)
  | (Option_t (_, _, _), Prim (loc, D_None, [], annot)) ->
      (if legacy then return () else fail_unexpected_annot loc annot)
      >>=? fun () ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.none)
      >>=? fun ctxt -> return (None, ctxt)
  | (Option_t _, Prim (loc, D_None, l, _)) ->
      fail @@ Invalid_arity (loc, D_None, 0, List.length l)
  | (Option_t _, expr) ->
      traced (fail (unexpected expr [] Constant_namespace [D_Some; D_None]))
  (* Lists *)
  | (List_t (t, _ty_name, _), Seq (_loc, items)) ->
      traced
      @@ fold_right_s
           (fun v (rest, ctxt) ->
             Lwt.return (Gas.consume ctxt Typecheck_costs.list_element)
             >>=? fun ctxt ->
             parse_data ?type_logger ctxt ~legacy t v
             >>=? fun (v, ctxt) -> return (v :: rest, ctxt))
           items
           ([], ctxt)
  | (List_t _, expr) ->
      traced (fail (Invalid_kind (location expr, [Seq_kind], kind expr)))
  (* Sets *)
  | (Set_t (t, _ty_name), (Seq (loc, vs) as expr)) ->
      let length = List.length vs in
      traced
      @@ fold_left_s
           (fun (last_value, set, ctxt) v ->
             Lwt.return (Gas.consume ctxt (Typecheck_costs.set_element length))
             >>=? fun ctxt ->
             parse_comparable_data ?type_logger ctxt t v
             >>=? fun (v, ctxt) ->
             ( match last_value with
             | Some value ->
                 if Compare.Int.(0 <= compare_comparable t value v) then
                   if Compare.Int.(0 = compare_comparable t value v) then
                     fail (Duplicate_set_values (loc, strip_locations expr))
                   else fail (Unordered_set_values (loc, strip_locations expr))
                 else return_unit
             | None ->
                 return_unit )
             >>=? fun () ->
             Lwt.return
               (Gas.consume
                  ctxt
                  (Michelson_v1_gas.Cost_of.Legacy.set_update v false set))
             >>=? fun ctxt -> return (Some v, set_update v true set, ctxt))
           (None, empty_set t, ctxt)
           vs
      >>|? fun (_, set, ctxt) -> (set, ctxt)
  | (Set_t _, expr) ->
      traced (fail (Invalid_kind (location expr, [Seq_kind], kind expr)))
  (* Maps *)
  | (Map_t (tk, tv, _ty_name, _), (Seq (loc, vs) as expr)) ->
      parse_items ?type_logger loc ctxt expr tk tv vs (fun x -> x)
  | (Map_t _, expr) ->
      traced (fail (Invalid_kind (location expr, [Seq_kind], kind expr)))
  | (Big_map_t (tk, tv, _ty_name), (Seq (loc, vs) as expr)) ->
      parse_items ?type_logger loc ctxt expr tk tv vs (fun x -> Some x)
      >>|? fun (diff, ctxt) ->
      ( {id = None; diff; key_type = ty_of_comparable_ty tk; value_type = tv},
        ctxt )
  | (Big_map_t (tk, tv, _ty_name), Int (loc, id)) -> (
      Big_map.exists ctxt id
      >>=? function
      | (_, None) ->
          traced (fail (Invalid_big_map (loc, id)))
      | (ctxt, Some (btk, btv)) ->
          Lwt.return
            ( parse_comparable_ty ctxt (Micheline.root btk)
            >>? fun (Ex_comparable_ty btk, ctxt) ->
            parse_packable_ty ctxt ~legacy (Micheline.root btv)
            >>? fun (Ex_ty btv, ctxt) ->
            comparable_ty_eq ctxt tk btk
            >>? fun Eq ->
            ty_eq ctxt tv btv
            >>? fun (Eq, ctxt) ->
            ok
              ( {
                  id = Some id;
                  diff = empty_map tk;
                  key_type = ty_of_comparable_ty tk;
                  value_type = tv;
                },
                ctxt ) ) )
  | (Big_map_t (_tk, _tv, _), expr) ->
      traced
        (fail (Invalid_kind (location expr, [Seq_kind; Int_kind], kind expr)))

and parse_comparable_data :
    type a.
    ?type_logger:type_logger ->
    context ->
    a comparable_ty ->
    Script.node ->
    (a * context) tzresult Lwt.t =
 fun ?type_logger ctxt ty script_data ->
  parse_data
    ?type_logger
    ctxt
    ~legacy:false
    (ty_of_comparable_ty ty)
    script_data

and parse_returning :
    type arg ret.
    ?type_logger:type_logger ->
    tc_context ->
    context ->
    legacy:bool ->
    arg ty * var_annot option ->
    ret ty ->
    Script.node ->
    ((arg, ret) lambda * context) tzresult Lwt.t =
 fun ?type_logger tc_context ctxt ~legacy (arg, arg_annot) ret script_instr ->
  parse_instr
    ?type_logger
    tc_context
    ctxt
    ~legacy
    script_instr
    (Item_t (arg, Empty_t, arg_annot))
  >>=? function
  | (Typed ({loc; aft = Item_t (ty, Empty_t, _) as stack_ty; _} as descr), ctxt)
    ->
      trace_eval
        (fun () ->
          Lwt.return (serialize_ty_for_error ctxt ret)
          >>=? fun (ret, ctxt) ->
          serialize_stack_for_error ctxt stack_ty
          >>|? fun (stack_ty, _ctxt) -> Bad_return (loc, stack_ty, ret))
        ( Lwt.return (ty_eq ctxt ty ret)
        >>=? fun (Eq, ctxt) ->
        Lwt.return (merge_types ~legacy ctxt loc ty ret)
        >>=? fun (_ret, ctxt) ->
        return ((Lam (descr, script_instr) : (arg, ret) lambda), ctxt) )
  | (Typed {loc; aft = stack_ty; _}, ctxt) ->
      Lwt.return (serialize_ty_for_error ctxt ret)
      >>=? fun (ret, ctxt) ->
      serialize_stack_for_error ctxt stack_ty
      >>=? fun (stack_ty, _ctxt) -> fail (Bad_return (loc, stack_ty, ret))
  | (Failed {descr}, ctxt) ->
      return
        ( ( Lam (descr (Item_t (ret, Empty_t, None)), script_instr)
            : (arg, ret) lambda ),
          ctxt )

and parse_int32 (n : (location, prim) Micheline.node) : int tzresult =
  let error' () =
    Invalid_syntactic_constant
      ( location n,
        strip_locations n,
        "a positive 32-bit integer (between 0 and "
        ^ Int32.to_string Int32.max_int
        ^ ")" )
  in
  match n with
  | Micheline.Int (_, n') -> (
    try
      let n'' = Z.to_int n' in
      if
        Compare.Int.(0 <= n'')
        && Compare.Int.(n'' <= Int32.to_int Int32.max_int)
      then ok n''
      else error @@ error' ()
    with _ -> error @@ error' () )
  | _ ->
      error @@ error' ()

and parse_instr :
    type bef.
    ?type_logger:type_logger ->
    tc_context ->
    context ->
    legacy:bool ->
    Script.node ->
    bef stack_ty ->
    (bef judgement * context) tzresult Lwt.t =
 fun ?type_logger tc_context ctxt ~legacy script_instr stack_ty ->
  let _check_item check loc name n m =
    trace_eval (fun () ->
        serialize_stack_for_error ctxt stack_ty
        >>|? fun (stack_ty, _ctxt) -> Bad_stack (loc, name, m, stack_ty))
    @@ trace (Bad_stack_item n) @@ Lwt.return check
  in
  let check_item_ty (type a b) ctxt (exp : a ty) (got : b ty) loc name n m :
      ((a, b) eq * a ty * context) tzresult Lwt.t =
    trace_eval (fun () ->
        serialize_stack_for_error ctxt stack_ty
        >>|? fun (stack_ty, _ctxt) -> Bad_stack (loc, name, m, stack_ty))
    @@ trace (Bad_stack_item n)
    @@ Lwt.return
         ( ty_eq ctxt exp got
         >>? fun (Eq, ctxt) ->
         merge_types ~legacy ctxt loc exp got
         >>? fun (ty, ctxt) -> ok ((Eq : (a, b) eq), (ty : a ty), ctxt) )
  in
  let check_item_comparable_ty (type a b) (exp : a comparable_ty)
      (got : b comparable_ty) loc name n m :
      ((a, b) eq * a comparable_ty) tzresult Lwt.t =
    trace_eval (fun () ->
        serialize_stack_for_error ctxt stack_ty
        >>|? fun (stack_ty, _ctxt) -> Bad_stack (loc, name, m, stack_ty))
    @@ trace (Bad_stack_item n)
    @@ Lwt.return
         ( comparable_ty_eq ctxt exp got
         >>? fun Eq ->
         merge_comparable_types ~legacy exp got
         >>? fun ty -> ok ((Eq : (a, b) eq), (ty : a comparable_ty)) )
  in
  let log_stack ctxt loc stack_ty aft =
    match (type_logger, script_instr) with
    | (None, _) | (Some _, (Seq (-1, _) | Int _ | String _ | Bytes _)) ->
        return_unit
    | (Some log, (Prim _ | Seq _)) ->
        (* Unparsing for logging done in an unlimited context as this
             is used only by the client and not the protocol *)
        let ctxt = Gas.set_unlimited ctxt in
        unparse_stack ctxt stack_ty
        >>=? fun (stack_ty, _) ->
        unparse_stack ctxt aft
        >>=? fun (aft, _) -> log loc stack_ty aft ; return_unit
  in
  let outer_return = return in
  let return :
      type bef.
      context -> bef judgement -> (bef judgement * context) tzresult Lwt.t =
   fun ctxt judgement ->
    match judgement with
    | Typed {instr; loc; aft; _} ->
        let maximum_type_size = Constants.michelson_maximum_type_size ctxt in
        let type_size =
          type_size_of_stack_head
            aft
            ~up_to:(number_of_generated_growing_types instr)
        in
        if Compare.Int.(type_size > maximum_type_size) then
          fail (Type_too_large (loc, type_size, maximum_type_size))
        else return (judgement, ctxt)
    | Failed _ ->
        return (judgement, ctxt)
  in
  let typed ctxt loc instr aft =
    log_stack ctxt loc stack_ty aft
    >>=? fun () ->
    Lwt.return @@ Gas.consume ctxt (Typecheck_costs.instr instr)
    >>=? fun ctxt -> return ctxt (Typed {loc; instr; bef = stack_ty; aft})
  in
  Lwt.return @@ Gas.consume ctxt Typecheck_costs.cycle
  >>=? fun ctxt ->
  match (script_instr, stack_ty) with
  (* stack ops *)
  | (Prim (loc, I_DROP, [], annot), Item_t (_, rest, _)) ->
      ( fail_unexpected_annot loc annot >>=? fun () -> typed ctxt loc Drop rest
        : (bef judgement * context) tzresult Lwt.t )
  | (Prim (loc, I_DROP, [n], result_annot), whole_stack) ->
      Lwt.return (parse_int32 n)
      >>=? fun whole_n ->
      let rec make_proof_argument :
          type tstk.
          int -> tstk stack_ty -> tstk dropn_proof_argument tzresult Lwt.t =
       fun n stk ->
        match (Compare.Int.(n = 0), stk) with
        | (true, rest) ->
            outer_return @@ Dropn_proof_argument (Rest, rest, rest)
        | (false, Item_t (v, rest, annot)) ->
            make_proof_argument (n - 1) rest
            >>=? fun (Dropn_proof_argument (n', stack_after_drops, aft')) ->
            outer_return
            @@ Dropn_proof_argument
                 (Prefix n', stack_after_drops, Item_t (v, aft', annot))
        | (_, _) ->
            serialize_stack_for_error ctxt whole_stack
            >>=? fun (whole_stack, _ctxt) ->
            fail (Bad_stack (loc, I_DROP, whole_n, whole_stack))
      in
      fail_unexpected_annot loc result_annot
      >>=? fun () ->
      make_proof_argument whole_n whole_stack
      >>=? fun (Dropn_proof_argument (n', stack_after_drops, _aft)) ->
      typed ctxt loc (Dropn (whole_n, n')) stack_after_drops
  | (Prim (loc, I_DROP, (_ :: _ :: _ as l), _), _) ->
      (* Technically, the arities 0 and 1 are allowed but the error only mentions 1.
           However, DROP is equivalent to DROP 1 so hinting at an arity of 1 makes sense. *)
      fail (Invalid_arity (loc, I_DROP, 1, List.length l))
  | (Prim (loc, I_DUP, [], annot), Item_t (v, rest, stack_annot)) ->
      parse_var_annot loc annot ~default:stack_annot
      >>=? fun annot ->
      typed ctxt loc Dup (Item_t (v, Item_t (v, rest, stack_annot), annot))
  | (Prim (loc, I_DIG, [n], result_annot), stack) ->
      let rec make_proof_argument :
          type tstk.
          int -> tstk stack_ty -> tstk dig_proof_argument tzresult Lwt.t =
       fun n stk ->
        match (Compare.Int.(n = 0), stk) with
        | (true, Item_t (v, rest, annot)) ->
            outer_return @@ Dig_proof_argument (Rest, (v, annot), rest)
        | (false, Item_t (v, rest, annot)) ->
            make_proof_argument (n - 1) rest
            >>=? fun (Dig_proof_argument (n', (x, xv), aft')) ->
            outer_return
            @@ Dig_proof_argument (Prefix n', (x, xv), Item_t (v, aft', annot))
        | (_, _) ->
            serialize_stack_for_error ctxt stack
            >>=? fun (whole_stack, _ctxt) ->
            fail (Bad_stack (loc, I_DIG, 1, whole_stack))
      in
      Lwt.return (parse_int32 n)
      >>=? fun n ->
      fail_unexpected_annot loc result_annot
      >>=? fun () ->
      make_proof_argument n stack
      >>=? fun (Dig_proof_argument (n', (x, stack_annot), aft)) ->
      typed ctxt loc (Dig (n, n')) (Item_t (x, aft, stack_annot))
  | (Prim (loc, I_DIG, (([] | _ :: _ :: _) as l), _), _) ->
      fail (Invalid_arity (loc, I_DIG, 1, List.length l))
  | (Prim (loc, I_DUG, [n], result_annot), Item_t (x, whole_stack, stack_annot))
    ->
      Lwt.return (parse_int32 n)
      >>=? fun whole_n ->
      let rec make_proof_argument :
          type tstk x.
          int ->
          x ty ->
          var_annot option ->
          tstk stack_ty ->
          (tstk, x) dug_proof_argument tzresult Lwt.t =
       fun n x stack_annot stk ->
        match (Compare.Int.(n = 0), stk) with
        | (true, rest) ->
            outer_return
            @@ Dug_proof_argument (Rest, (), Item_t (x, rest, stack_annot))
        | (false, Item_t (v, rest, annot)) ->
            make_proof_argument (n - 1) x stack_annot rest
            >>=? fun (Dug_proof_argument (n', (), aft')) ->
            outer_return
            @@ Dug_proof_argument (Prefix n', (), Item_t (v, aft', annot))
        | (_, _) ->
            serialize_stack_for_error ctxt whole_stack
            >>=? fun (whole_stack, _ctxt) ->
            fail (Bad_stack (loc, I_DUG, whole_n, whole_stack))
      in
      fail_unexpected_annot loc result_annot
      >>=? fun () ->
      make_proof_argument whole_n x stack_annot whole_stack
      >>=? fun (Dug_proof_argument (n', (), aft)) ->
      typed ctxt loc (Dug (whole_n, n')) aft
  | (Prim (loc, I_DUG, [_], result_annot), (Empty_t as stack)) ->
      fail_unexpected_annot loc result_annot
      >>=? fun () ->
      serialize_stack_for_error ctxt stack
      >>=? fun (stack, _ctxt) -> fail (Bad_stack (loc, I_DUG, 1, stack))
  | (Prim (loc, I_DUG, (([] | _ :: _ :: _) as l), _), _) ->
      fail (Invalid_arity (loc, I_DUG, 1, List.length l))
  | ( Prim (loc, I_SWAP, [], annot),
      Item_t (v, Item_t (w, rest, stack_annot), cur_top_annot) ) ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      typed
        ctxt
        loc
        Swap
        (Item_t (w, Item_t (v, rest, cur_top_annot), stack_annot))
  | (Prim (loc, I_PUSH, [t; d], annot), stack) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ parse_packable_ty ctxt ~legacy t
      >>=? fun (Ex_ty t, ctxt) ->
      parse_data ?type_logger ctxt ~legacy t d
      >>=? fun (v, ctxt) -> typed ctxt loc (Const v) (Item_t (t, stack, annot))
  | (Prim (loc, I_UNIT, [], annot), stack) ->
      parse_var_type_annot loc annot
      >>=? fun (annot, ty_name) ->
      typed ctxt loc (Const ()) (Item_t (Unit_t ty_name, stack, annot))
  (* options *)
  | (Prim (loc, I_SOME, [], annot), Item_t (t, rest, _)) ->
      parse_var_type_annot loc annot
      >>=? fun (annot, ty_name) ->
      typed
        ctxt
        loc
        Cons_some
        (Item_t (Option_t (t, ty_name, has_big_map t), rest, annot))
  | (Prim (loc, I_NONE, [t], annot), stack) ->
      Lwt.return @@ parse_any_ty ctxt ~legacy t
      >>=? fun (Ex_ty t, ctxt) ->
      parse_var_type_annot loc annot
      >>=? fun (annot, ty_name) ->
      typed
        ctxt
        loc
        (Cons_none t)
        (Item_t (Option_t (t, ty_name, has_big_map t), stack, annot))
  | ( Prim (loc, I_IF_NONE, [bt; bf], annot),
      (Item_t (Option_t (t, _, _), rest, option_annot) as bef) ) ->
      check_kind [Seq_kind] bt
      >>=? fun () ->
      check_kind [Seq_kind] bf
      >>=? fun () ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      let annot = gen_access_annot option_annot default_some_annot in
      parse_instr ?type_logger tc_context ctxt ~legacy bt rest
      >>=? fun (btr, ctxt) ->
      parse_instr
        ?type_logger
        tc_context
        ctxt
        ~legacy
        bf
        (Item_t (t, rest, annot))
      >>=? fun (bfr, ctxt) ->
      let branch ibt ibf =
        {loc; instr = If_none (ibt, ibf); bef; aft = ibt.aft}
      in
      merge_branches ~legacy ctxt loc btr bfr {branch}
      >>=? fun (judgement, ctxt) -> return ctxt judgement
  (* pairs *)
  | ( Prim (loc, I_PAIR, [], annot),
      Item_t (a, Item_t (b, rest, snd_annot), fst_annot) ) ->
      parse_constr_annot
        loc
        annot
        ~if_special_first:(var_to_field_annot fst_annot)
        ~if_special_second:(var_to_field_annot snd_annot)
      >>=? fun (annot, ty_name, l_field, r_field) ->
      typed
        ctxt
        loc
        Cons_pair
        (Item_t
           ( Pair_t
               ( (a, l_field, fst_annot),
                 (b, r_field, snd_annot),
                 ty_name,
                 has_big_map a || has_big_map b ),
             rest,
             annot ))
  | ( Prim (loc, I_CAR, [], annot),
      Item_t
        (Pair_t ((a, expected_field_annot, a_annot), _, _, _), rest, pair_annot)
    ) ->
      parse_destr_annot
        loc
        annot
        ~pair_annot
        ~value_annot:a_annot
        ~field_name:expected_field_annot
        ~default_accessor:default_car_annot
      >>=? fun (annot, field_annot) ->
      Lwt.return @@ check_correct_field field_annot expected_field_annot
      >>=? fun () -> typed ctxt loc Car (Item_t (a, rest, annot))
  | ( Prim (loc, I_CDR, [], annot),
      Item_t
        (Pair_t (_, (b, expected_field_annot, b_annot), _, _), rest, pair_annot)
    ) ->
      parse_destr_annot
        loc
        annot
        ~pair_annot
        ~value_annot:b_annot
        ~field_name:expected_field_annot
        ~default_accessor:default_cdr_annot
      >>=? fun (annot, field_annot) ->
      Lwt.return @@ check_correct_field field_annot expected_field_annot
      >>=? fun () -> typed ctxt loc Cdr (Item_t (b, rest, annot))
  (* unions *)
  | (Prim (loc, I_LEFT, [tr], annot), Item_t (tl, rest, stack_annot)) ->
      Lwt.return @@ parse_any_ty ctxt ~legacy tr
      >>=? fun (Ex_ty tr, ctxt) ->
      parse_constr_annot
        loc
        annot
        ~if_special_first:(var_to_field_annot stack_annot)
      >>=? fun (annot, tname, l_field, r_field) ->
      typed
        ctxt
        loc
        Left
        (Item_t
           ( Union_t
               ( (tl, l_field),
                 (tr, r_field),
                 tname,
                 has_big_map tl || has_big_map tr ),
             rest,
             annot ))
  | (Prim (loc, I_RIGHT, [tl], annot), Item_t (tr, rest, stack_annot)) ->
      Lwt.return @@ parse_any_ty ctxt ~legacy tl
      >>=? fun (Ex_ty tl, ctxt) ->
      parse_constr_annot
        loc
        annot
        ~if_special_second:(var_to_field_annot stack_annot)
      >>=? fun (annot, tname, l_field, r_field) ->
      typed
        ctxt
        loc
        Right
        (Item_t
           ( Union_t
               ( (tl, l_field),
                 (tr, r_field),
                 tname,
                 has_big_map tl || has_big_map tr ),
             rest,
             annot ))
  | ( Prim (loc, I_IF_LEFT, [bt; bf], annot),
      ( Item_t (Union_t ((tl, l_field), (tr, r_field), _, _), rest, union_annot)
      as bef ) ) ->
      check_kind [Seq_kind] bt
      >>=? fun () ->
      check_kind [Seq_kind] bf
      >>=? fun () ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      let left_annot =
        gen_access_annot union_annot l_field ~default:default_left_annot
      in
      let right_annot =
        gen_access_annot union_annot r_field ~default:default_right_annot
      in
      parse_instr
        ?type_logger
        tc_context
        ctxt
        ~legacy
        bt
        (Item_t (tl, rest, left_annot))
      >>=? fun (btr, ctxt) ->
      parse_instr
        ?type_logger
        tc_context
        ctxt
        ~legacy
        bf
        (Item_t (tr, rest, right_annot))
      >>=? fun (bfr, ctxt) ->
      let branch ibt ibf =
        {loc; instr = If_left (ibt, ibf); bef; aft = ibt.aft}
      in
      merge_branches ~legacy ctxt loc btr bfr {branch}
      >>=? fun (judgement, ctxt) -> return ctxt judgement
  (* lists *)
  | (Prim (loc, I_NIL, [t], annot), stack) ->
      Lwt.return @@ parse_any_ty ctxt ~legacy t
      >>=? fun (Ex_ty t, ctxt) ->
      parse_var_type_annot loc annot
      >>=? fun (annot, ty_name) ->
      typed
        ctxt
        loc
        Nil
        (Item_t (List_t (t, ty_name, has_big_map t), stack, annot))
  | ( Prim (loc, I_CONS, [], annot),
      Item_t (tv, Item_t (List_t (t, ty_name, has_big_map), rest, _), _) ) ->
      check_item_ty ctxt tv t loc I_CONS 1 2
      >>=? fun (Eq, t, ctxt) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Cons_list
        (Item_t (List_t (t, ty_name, has_big_map), rest, annot))
  | ( Prim (loc, I_IF_CONS, [bt; bf], annot),
      (Item_t (List_t (t, ty_name, has_big_map), rest, list_annot) as bef) ) ->
      check_kind [Seq_kind] bt
      >>=? fun () ->
      check_kind [Seq_kind] bf
      >>=? fun () ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      let hd_annot = gen_access_annot list_annot default_hd_annot in
      let tl_annot = gen_access_annot list_annot default_tl_annot in
      parse_instr
        ?type_logger
        tc_context
        ctxt
        ~legacy
        bt
        (Item_t
           ( t,
             Item_t (List_t (t, ty_name, has_big_map), rest, tl_annot),
             hd_annot ))
      >>=? fun (btr, ctxt) ->
      parse_instr ?type_logger tc_context ctxt ~legacy bf rest
      >>=? fun (bfr, ctxt) ->
      let branch ibt ibf =
        {loc; instr = If_cons (ibt, ibf); bef; aft = ibt.aft}
      in
      merge_branches ~legacy ctxt loc btr bfr {branch}
      >>=? fun (judgement, ctxt) -> return ctxt judgement
  | (Prim (loc, I_SIZE, [], annot), Item_t (List_t _, rest, _)) ->
      parse_var_type_annot loc annot
      >>=? fun (annot, tname) ->
      typed ctxt loc List_size (Item_t (Nat_t tname, rest, annot))
  | ( Prim (loc, I_MAP, [body], annot),
      Item_t (List_t (elt, _, _), starting_rest, list_annot) ) -> (
      check_kind [Seq_kind] body
      >>=? fun () ->
      parse_var_type_annot loc annot
      >>=? fun (ret_annot, list_ty_name) ->
      let elt_annot = gen_access_annot list_annot default_elt_annot in
      parse_instr
        ?type_logger
        tc_context
        ctxt
        ~legacy
        body
        (Item_t (elt, starting_rest, elt_annot))
      >>=? fun (judgement, ctxt) ->
      match judgement with
      | Typed ({aft = Item_t (ret, rest, _); _} as ibody) ->
          let invalid_map_body () =
            serialize_stack_for_error ctxt ibody.aft
            >>|? fun (aft, _ctxt) -> Invalid_map_body (loc, aft)
          in
          trace_eval
            invalid_map_body
            ( Lwt.return @@ stack_ty_eq ctxt 1 rest starting_rest
            >>=? fun (Eq, ctxt) ->
            Lwt.return @@ merge_stacks ~legacy loc ctxt rest starting_rest
            >>=? fun (rest, ctxt) ->
            typed
              ctxt
              loc
              (List_map ibody)
              (Item_t
                 (List_t (ret, list_ty_name, has_big_map ret), rest, ret_annot))
            )
      | Typed {aft; _} ->
          serialize_stack_for_error ctxt aft
          >>=? fun (aft, _ctxt) -> fail (Invalid_map_body (loc, aft))
      | Failed _ ->
          fail (Invalid_map_block_fail loc) )
  | ( Prim (loc, I_ITER, [body], annot),
      Item_t (List_t (elt, _, _), rest, list_annot) ) -> (
      check_kind [Seq_kind] body
      >>=? fun () ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      let elt_annot = gen_access_annot list_annot default_elt_annot in
      parse_instr
        ?type_logger
        tc_context
        ctxt
        ~legacy
        body
        (Item_t (elt, rest, elt_annot))
      >>=? fun (judgement, ctxt) ->
      match judgement with
      | Typed ({aft; _} as ibody) ->
          let invalid_iter_body () =
            serialize_stack_for_error ctxt ibody.aft
            >>=? fun (aft, ctxt) ->
            serialize_stack_for_error ctxt rest
            >>|? fun (rest, _ctxt) -> Invalid_iter_body (loc, rest, aft)
          in
          trace_eval
            invalid_iter_body
            ( Lwt.return @@ stack_ty_eq ctxt 1 aft rest
            >>=? fun (Eq, ctxt) ->
            Lwt.return @@ merge_stacks ~legacy loc ctxt aft rest
            >>=? fun (rest, ctxt) -> typed ctxt loc (List_iter ibody) rest )
      | Failed {descr} ->
          typed ctxt loc (List_iter (descr rest)) rest )
  (* sets *)
  | (Prim (loc, I_EMPTY_SET, [t], annot), rest) ->
      Lwt.return @@ parse_comparable_ty ctxt t
      >>=? fun (Ex_comparable_ty t, ctxt) ->
      parse_var_type_annot loc annot
      >>=? fun (annot, tname) ->
      typed ctxt loc (Empty_set t) (Item_t (Set_t (t, tname), rest, annot))
  | ( Prim (loc, I_ITER, [body], annot),
      Item_t (Set_t (comp_elt, _), rest, set_annot) ) -> (
      check_kind [Seq_kind] body
      >>=? fun () ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      let elt_annot = gen_access_annot set_annot default_elt_annot in
      let elt = ty_of_comparable_ty comp_elt in
      parse_instr
        ?type_logger
        tc_context
        ctxt
        ~legacy
        body
        (Item_t (elt, rest, elt_annot))
      >>=? fun (judgement, ctxt) ->
      match judgement with
      | Typed ({aft; _} as ibody) ->
          let invalid_iter_body () =
            serialize_stack_for_error ctxt ibody.aft
            >>=? fun (aft, ctxt) ->
            serialize_stack_for_error ctxt rest
            >>|? fun (rest, _ctxt) -> Invalid_iter_body (loc, rest, aft)
          in
          trace_eval
            invalid_iter_body
            ( Lwt.return @@ stack_ty_eq ctxt 1 aft rest
            >>=? fun (Eq, ctxt) ->
            Lwt.return @@ merge_stacks ~legacy loc ctxt aft rest
            >>=? fun (rest, ctxt) -> typed ctxt loc (Set_iter ibody) rest )
      | Failed {descr} ->
          typed ctxt loc (Set_iter (descr rest)) rest )
  | ( Prim (loc, I_MEM, [], annot),
      Item_t (v, Item_t (Set_t (elt, _), rest, _), _) ) ->
      let elt = ty_of_comparable_ty elt in
      parse_var_type_annot loc annot
      >>=? fun (annot, tname) ->
      check_item_ty ctxt elt v loc I_MEM 1 2
      >>=? fun (Eq, _, ctxt) ->
      typed ctxt loc Set_mem (Item_t (Bool_t tname, rest, annot))
  | ( Prim (loc, I_UPDATE, [], annot),
      Item_t
        ( v,
          Item_t (Bool_t _, Item_t (Set_t (elt, tname), rest, set_annot), _),
          _ ) ) -> (
    match comparable_ty_of_ty v with
    | None ->
        unparse_ty ctxt v
        >>=? fun (v, _ctxt) ->
        fail (Comparable_type_expected (loc, Micheline.strip_locations v))
    | Some v ->
        parse_var_annot loc annot ~default:set_annot
        >>=? fun annot ->
        check_item_comparable_ty elt v loc I_UPDATE 1 3
        >>=? fun (Eq, elt) ->
        typed ctxt loc Set_update (Item_t (Set_t (elt, tname), rest, annot)) )
  | (Prim (loc, I_SIZE, [], annot), Item_t (Set_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Set_size (Item_t (Nat_t None, rest, annot))
  (* maps *)
  | (Prim (loc, I_EMPTY_MAP, [tk; tv], annot), stack) ->
      Lwt.return @@ parse_comparable_ty ctxt tk
      >>=? fun (Ex_comparable_ty tk, ctxt) ->
      Lwt.return @@ parse_any_ty ctxt ~legacy tv
      >>=? fun (Ex_ty tv, ctxt) ->
      parse_var_type_annot loc annot
      >>=? fun (annot, ty_name) ->
      typed
        ctxt
        loc
        (Empty_map (tk, tv))
        (Item_t (Map_t (tk, tv, ty_name, has_big_map tv), stack, annot))
  | ( Prim (loc, I_MAP, [body], annot),
      Item_t (Map_t (ck, elt, _, _), starting_rest, _map_annot) ) -> (
      let k = ty_of_comparable_ty ck in
      check_kind [Seq_kind] body
      >>=? fun () ->
      parse_var_type_annot loc annot
      >>=? fun (ret_annot, ty_name) ->
      let k_name = field_to_var_annot default_key_annot in
      let e_name = field_to_var_annot default_elt_annot in
      parse_instr
        ?type_logger
        tc_context
        ctxt
        ~legacy
        body
        (Item_t
           ( Pair_t
               ((k, None, k_name), (elt, None, e_name), None, has_big_map elt),
             starting_rest,
             None ))
      >>=? fun (judgement, ctxt) ->
      match judgement with
      | Typed ({aft = Item_t (ret, rest, _); _} as ibody) ->
          let invalid_map_body () =
            serialize_stack_for_error ctxt ibody.aft
            >>|? fun (aft, _ctxt) -> Invalid_map_body (loc, aft)
          in
          trace_eval
            invalid_map_body
            ( Lwt.return @@ stack_ty_eq ctxt 1 rest starting_rest
            >>=? fun (Eq, ctxt) ->
            Lwt.return @@ merge_stacks ~legacy loc ctxt rest starting_rest
            >>=? fun (rest, ctxt) ->
            typed
              ctxt
              loc
              (Map_map ibody)
              (Item_t
                 (Map_t (ck, ret, ty_name, has_big_map ret), rest, ret_annot))
            )
      | Typed {aft; _} ->
          serialize_stack_for_error ctxt aft
          >>=? fun (aft, _ctxt) -> fail (Invalid_map_body (loc, aft))
      | Failed _ ->
          fail (Invalid_map_block_fail loc) )
  | ( Prim (loc, I_ITER, [body], annot),
      Item_t (Map_t (comp_elt, element_ty, _, _), rest, _map_annot) ) -> (
      check_kind [Seq_kind] body
      >>=? fun () ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      let k_name = field_to_var_annot default_key_annot in
      let e_name = field_to_var_annot default_elt_annot in
      let key = ty_of_comparable_ty comp_elt in
      parse_instr
        ?type_logger
        tc_context
        ctxt
        ~legacy
        body
        (Item_t
           ( Pair_t
               ( (key, None, k_name),
                 (element_ty, None, e_name),
                 None,
                 has_big_map element_ty ),
             rest,
             None ))
      >>=? fun (judgement, ctxt) ->
      match judgement with
      | Typed ({aft; _} as ibody) ->
          let invalid_iter_body () =
            serialize_stack_for_error ctxt ibody.aft
            >>=? fun (aft, ctxt) ->
            serialize_stack_for_error ctxt rest
            >>|? fun (rest, _ctxt) -> Invalid_iter_body (loc, rest, aft)
          in
          trace_eval
            invalid_iter_body
            ( Lwt.return @@ stack_ty_eq ctxt 1 aft rest
            >>=? fun (Eq, ctxt) ->
            Lwt.return @@ merge_stacks ~legacy loc ctxt aft rest
            >>=? fun (rest, ctxt) -> typed ctxt loc (Map_iter ibody) rest )
      | Failed {descr} ->
          typed ctxt loc (Map_iter (descr rest)) rest )
  | ( Prim (loc, I_MEM, [], annot),
      Item_t (vk, Item_t (Map_t (ck, _, _, _), rest, _), _) ) ->
      let k = ty_of_comparable_ty ck in
      check_item_ty ctxt vk k loc I_MEM 1 2
      >>=? fun (Eq, _, ctxt) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Map_mem (Item_t (Bool_t None, rest, annot))
  | ( Prim (loc, I_GET, [], annot),
      Item_t (vk, Item_t (Map_t (ck, elt, _, has_big_map), rest, _), _) ) ->
      let k = ty_of_comparable_ty ck in
      check_item_ty ctxt vk k loc I_GET 1 2
      >>=? fun (Eq, _, ctxt) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Map_get
        (Item_t (Option_t (elt, None, has_big_map), rest, annot))
  | ( Prim (loc, I_UPDATE, [], annot),
      Item_t
        ( vk,
          Item_t
            ( Option_t (vv, _, _),
              Item_t (Map_t (ck, v, map_name, has_big_map), rest, map_annot),
              _ ),
          _ ) ) ->
      let k = ty_of_comparable_ty ck in
      check_item_ty ctxt vk k loc I_UPDATE 1 3
      >>=? fun (Eq, _, ctxt) ->
      check_item_ty ctxt vv v loc I_UPDATE 2 3
      >>=? fun (Eq, v, ctxt) ->
      parse_var_annot loc annot ~default:map_annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Map_update
        (Item_t (Map_t (ck, v, map_name, has_big_map), rest, annot))
  | (Prim (loc, I_SIZE, [], annot), Item_t (Map_t (_, _, _, _), rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Map_size (Item_t (Nat_t None, rest, annot))
  (* big_map *)
  | (Prim (loc, I_EMPTY_BIG_MAP, [tk; tv], annot), stack) ->
      Lwt.return @@ parse_comparable_ty ctxt tk
      >>=? fun (Ex_comparable_ty tk, ctxt) ->
      Lwt.return @@ parse_packable_ty ctxt ~legacy tv
      >>=? fun (Ex_ty tv, ctxt) ->
      parse_var_type_annot loc annot
      >>=? fun (annot, ty_name) ->
      typed
        ctxt
        loc
        (Empty_big_map (tk, tv))
        (Item_t (Big_map_t (tk, tv, ty_name), stack, annot))
  | ( Prim (loc, I_MEM, [], annot),
      Item_t (set_key, Item_t (Big_map_t (map_key, _, _), rest, _), _) ) ->
      let k = ty_of_comparable_ty map_key in
      check_item_ty ctxt set_key k loc I_MEM 1 2
      >>=? fun (Eq, _, ctxt) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Big_map_mem (Item_t (Bool_t None, rest, annot))
  | ( Prim (loc, I_GET, [], annot),
      Item_t (vk, Item_t (Big_map_t (ck, elt, _), rest, _), _) ) ->
      let k = ty_of_comparable_ty ck in
      check_item_ty ctxt vk k loc I_GET 1 2
      >>=? fun (Eq, _, ctxt) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Big_map_get
        (Item_t (Option_t (elt, None, has_big_map elt), rest, annot))
  | ( Prim (loc, I_UPDATE, [], annot),
      Item_t
        ( set_key,
          Item_t
            ( Option_t (set_value, _, _),
              Item_t (Big_map_t (map_key, map_value, map_name), rest, map_annot),
              _ ),
          _ ) ) ->
      let k = ty_of_comparable_ty map_key in
      check_item_ty ctxt set_key k loc I_UPDATE 1 3
      >>=? fun (Eq, _, ctxt) ->
      check_item_ty ctxt set_value map_value loc I_UPDATE 2 3
      >>=? fun (Eq, map_value, ctxt) ->
      parse_var_annot loc annot ~default:map_annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Big_map_update
        (Item_t (Big_map_t (map_key, map_value, map_name), rest, annot))
  (* control *)
  | (Seq (loc, []), stack) ->
      typed ctxt loc Nop stack
  | (Seq (loc, [single]), stack) -> (
      parse_instr ?type_logger tc_context ctxt ~legacy single stack
      >>=? fun (judgement, ctxt) ->
      match judgement with
      | Typed ({aft; _} as instr) ->
          let nop = {bef = aft; loc; aft; instr = Nop} in
          typed ctxt loc (Seq (instr, nop)) aft
      | Failed {descr; _} ->
          let descr aft =
            let nop = {bef = aft; loc; aft; instr = Nop} in
            let descr = descr aft in
            {descr with instr = Seq (descr, nop)}
          in
          return ctxt (Failed {descr}) )
  | (Seq (loc, hd :: tl), stack) -> (
      parse_instr ?type_logger tc_context ctxt ~legacy hd stack
      >>=? fun (judgement, ctxt) ->
      match judgement with
      | Failed _ ->
          fail (Fail_not_in_tail_position (Micheline.location hd))
      | Typed ({aft = middle; _} as ihd) -> (
          parse_instr
            ?type_logger
            tc_context
            ctxt
            ~legacy
            (Seq (-1, tl))
            middle
          >>=? fun (judgement, ctxt) ->
          match judgement with
          | Failed {descr} ->
              let descr ret =
                {loc; instr = Seq (ihd, descr ret); bef = stack; aft = ret}
              in
              return ctxt (Failed {descr})
          | Typed itl ->
              typed ctxt loc (Seq (ihd, itl)) itl.aft ) )
  | (Prim (loc, I_IF, [bt; bf], annot), (Item_t (Bool_t _, rest, _) as bef)) ->
      check_kind [Seq_kind] bt
      >>=? fun () ->
      check_kind [Seq_kind] bf
      >>=? fun () ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      parse_instr ?type_logger tc_context ctxt ~legacy bt rest
      >>=? fun (btr, ctxt) ->
      parse_instr ?type_logger tc_context ctxt ~legacy bf rest
      >>=? fun (bfr, ctxt) ->
      let branch ibt ibf = {loc; instr = If (ibt, ibf); bef; aft = ibt.aft} in
      merge_branches ~legacy ctxt loc btr bfr {branch}
      >>=? fun (judgement, ctxt) -> return ctxt judgement
  | ( Prim (loc, I_LOOP, [body], annot),
      (Item_t (Bool_t _, rest, _stack_annot) as stack) ) -> (
      check_kind [Seq_kind] body
      >>=? fun () ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      parse_instr ?type_logger tc_context ctxt ~legacy body rest
      >>=? fun (judgement, ctxt) ->
      match judgement with
      | Typed ibody ->
          let unmatched_branches () =
            serialize_stack_for_error ctxt ibody.aft
            >>=? fun (aft, ctxt) ->
            serialize_stack_for_error ctxt stack
            >>|? fun (stack, _ctxt) -> Unmatched_branches (loc, aft, stack)
          in
          trace_eval
            unmatched_branches
            ( Lwt.return @@ stack_ty_eq ctxt 1 ibody.aft stack
            >>=? fun (Eq, ctxt) ->
            Lwt.return @@ merge_stacks ~legacy loc ctxt ibody.aft stack
            >>=? fun (_stack, ctxt) -> typed ctxt loc (Loop ibody) rest )
      | Failed {descr} ->
          let ibody = descr stack in
          typed ctxt loc (Loop ibody) rest )
  | ( Prim (loc, I_LOOP_LEFT, [body], annot),
      ( Item_t (Union_t ((tl, l_field), (tr, _), _, _), rest, union_annot) as
      stack ) ) -> (
      check_kind [Seq_kind] body
      >>=? fun () ->
      parse_var_annot loc annot
      >>=? fun annot ->
      let l_annot =
        gen_access_annot union_annot l_field ~default:default_left_annot
      in
      parse_instr
        ?type_logger
        tc_context
        ctxt
        ~legacy
        body
        (Item_t (tl, rest, l_annot))
      >>=? fun (judgement, ctxt) ->
      match judgement with
      | Typed ibody ->
          let unmatched_branches () =
            serialize_stack_for_error ctxt ibody.aft
            >>=? fun (aft, ctxt) ->
            serialize_stack_for_error ctxt stack
            >>|? fun (stack, _ctxt) -> Unmatched_branches (loc, aft, stack)
          in
          trace_eval
            unmatched_branches
            ( Lwt.return @@ stack_ty_eq ctxt 1 ibody.aft stack
            >>=? fun (Eq, ctxt) ->
            Lwt.return @@ merge_stacks ~legacy loc ctxt ibody.aft stack
            >>=? fun (_stack, ctxt) ->
            typed ctxt loc (Loop_left ibody) (Item_t (tr, rest, annot)) )
      | Failed {descr} ->
          let ibody = descr stack in
          typed ctxt loc (Loop_left ibody) (Item_t (tr, rest, annot)) )
  | (Prim (loc, I_LAMBDA, [arg; ret; code], annot), stack) ->
      Lwt.return @@ parse_any_ty ctxt ~legacy arg
      >>=? fun (Ex_ty arg, ctxt) ->
      Lwt.return @@ parse_any_ty ctxt ~legacy ret
      >>=? fun (Ex_ty ret, ctxt) ->
      check_kind [Seq_kind] code
      >>=? fun () ->
      parse_var_annot loc annot
      >>=? fun annot ->
      parse_returning
        Lambda
        ?type_logger
        ctxt
        ~legacy
        (arg, default_arg_annot)
        ret
        code
      >>=? fun (lambda, ctxt) ->
      typed
        ctxt
        loc
        (Lambda lambda)
        (Item_t (Lambda_t (arg, ret, None), stack, annot))
  | ( Prim (loc, I_EXEC, [], annot),
      Item_t (arg, Item_t (Lambda_t (param, ret, _), rest, _), _) ) ->
      check_item_ty ctxt arg param loc I_EXEC 1 2
      >>=? fun (Eq, _, ctxt) ->
      parse_var_annot loc annot
      >>=? fun annot -> typed ctxt loc Exec (Item_t (ret, rest, annot))
  | ( Prim (loc, I_APPLY, [], annot),
      Item_t
        ( capture,
          Item_t
            ( Lambda_t
                ( Pair_t ((capture_ty, _, _), (arg_ty, _, _), lam_annot, _),
                  ret,
                  _ ),
              rest,
              _ ),
          _ ) ) ->
      Lwt.return @@ check_packable ~legacy:false loc capture_ty
      >>=? fun () ->
      check_item_ty ctxt capture capture_ty loc I_APPLY 1 2
      >>=? fun (Eq, capture_ty, ctxt) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        (Apply capture_ty)
        (Item_t (Lambda_t (arg_ty, ret, lam_annot), rest, annot))
  | (Prim (loc, I_DIP, [code], annot), Item_t (v, rest, stack_annot)) -> (
      fail_unexpected_annot loc annot
      >>=? fun () ->
      check_kind [Seq_kind] code
      >>=? fun () ->
      parse_instr
        ?type_logger
        (add_dip v stack_annot tc_context)
        ctxt
        ~legacy
        code
        rest
      >>=? fun (judgement, ctxt) ->
      match judgement with
      | Typed descr ->
          typed ctxt loc (Dip descr) (Item_t (v, descr.aft, stack_annot))
      | Failed _ ->
          fail (Fail_not_in_tail_position loc) )
  | (Prim (loc, I_DIP, [n; code], result_annot), stack)
    when match parse_int32 n with Ok _ -> true | Error _ -> false ->
      let rec make_proof_argument :
          type tstk.
          int
          (* -> (fbef stack_ty -> (fbef judgement * context) tzresult Lwt.t) *) ->
          tc_context ->
          tstk stack_ty ->
          tstk dipn_proof_argument tzresult Lwt.t =
       fun n inner_tc_context stk ->
        match (Compare.Int.(n = 0), stk) with
        | (true, rest) -> (
            parse_instr ?type_logger inner_tc_context ctxt ~legacy code rest
            >>=? fun (judgement, ctxt) ->
            match judgement with
            | Typed descr ->
                outer_return
                @@ Dipn_proof_argument (Rest, (ctxt, descr), descr.aft)
            | Failed _ ->
                fail (Fail_not_in_tail_position loc) )
        | (false, Item_t (v, rest, annot)) ->
            make_proof_argument (n - 1) (add_dip v annot tc_context) rest
            >>=? fun (Dipn_proof_argument (n', descr, aft')) ->
            outer_return
            @@ Dipn_proof_argument (Prefix n', descr, Item_t (v, aft', annot))
        | (_, _) ->
            serialize_stack_for_error ctxt stack
            >>=? fun (whole_stack, _ctxt) ->
            fail (Bad_stack (loc, I_DIP, 1, whole_stack))
      in
      Lwt.return (parse_int32 n)
      >>=? fun n ->
      fail_unexpected_annot loc result_annot
      >>=? fun () ->
      make_proof_argument n tc_context stack
      >>=? fun (Dipn_proof_argument (n', (new_ctxt, descr), aft)) ->
      (* TODO: which context should be used in the next line? new_ctxt or the old ctxt? *)
      typed new_ctxt loc (Dipn (n, n', descr)) aft
  | (Prim (loc, I_DIP, (([] | _ :: _ :: _ :: _) as l), _), _) ->
      (* Technically, the arities 1 and 2 are allowed but the error only mentions 2.
           However, DIP {code} is equivalent to DIP 1 {code} so hinting at an arity of 2 makes sense. *)
      fail (Invalid_arity (loc, I_DIP, 2, List.length l))
  | (Prim (loc, I_FAILWITH, [], annot), Item_t (v, _rest, _)) ->
      fail_unexpected_annot loc annot
      >>=? fun () ->
      let descr aft = {loc; instr = Failwith v; bef = stack_ty; aft} in
      log_stack ctxt loc stack_ty Empty_t
      >>=? fun () -> return ctxt (Failed {descr})
  (* timestamp operations *)
  | ( Prim (loc, I_ADD, [], annot),
      Item_t (Timestamp_t tname, Item_t (Int_t _, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Add_timestamp_to_seconds
        (Item_t (Timestamp_t tname, rest, annot))
  | ( Prim (loc, I_ADD, [], annot),
      Item_t (Int_t _, Item_t (Timestamp_t tname, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Add_seconds_to_timestamp
        (Item_t (Timestamp_t tname, rest, annot))
  | ( Prim (loc, I_SUB, [], annot),
      Item_t (Timestamp_t tname, Item_t (Int_t _, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Sub_timestamp_seconds
        (Item_t (Timestamp_t tname, rest, annot))
  | ( Prim (loc, I_SUB, [], annot),
      Item_t (Timestamp_t tn1, Item_t (Timestamp_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Diff_timestamps (Item_t (Int_t tname, rest, annot))
  (* string operations *)
  | ( Prim (loc, I_CONCAT, [], annot),
      Item_t (String_t tn1, Item_t (String_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Concat_string_pair (Item_t (String_t tname, rest, annot))
  | ( Prim (loc, I_CONCAT, [], annot),
      Item_t (List_t (String_t tname, _, _), rest, list_annot) ) ->
      parse_var_annot ~default:list_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Concat_string (Item_t (String_t tname, rest, annot))
  | ( Prim (loc, I_SLICE, [], annot),
      Item_t
        ( Nat_t _,
          Item_t (Nat_t _, Item_t (String_t tname, rest, string_annot), _),
          _ ) ) ->
      parse_var_annot
        ~default:(gen_access_annot string_annot default_slice_annot)
        loc
        annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Slice_string
        (Item_t (Option_t (String_t tname, None, false), rest, annot))
  | (Prim (loc, I_SIZE, [], annot), Item_t (String_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc String_size (Item_t (Nat_t None, rest, annot))
  (* bytes operations *)
  | ( Prim (loc, I_CONCAT, [], annot),
      Item_t (Bytes_t tn1, Item_t (Bytes_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Concat_bytes_pair (Item_t (Bytes_t tname, rest, annot))
  | ( Prim (loc, I_CONCAT, [], annot),
      Item_t (List_t (Bytes_t tname, _, _), rest, list_annot) ) ->
      parse_var_annot ~default:list_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Concat_bytes (Item_t (Bytes_t tname, rest, annot))
  | ( Prim (loc, I_SLICE, [], annot),
      Item_t
        ( Nat_t _,
          Item_t (Nat_t _, Item_t (Bytes_t tname, rest, bytes_annot), _),
          _ ) ) ->
      parse_var_annot
        ~default:(gen_access_annot bytes_annot default_slice_annot)
        loc
        annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Slice_bytes
        (Item_t (Option_t (Bytes_t tname, None, false), rest, annot))
  | (Prim (loc, I_SIZE, [], annot), Item_t (Bytes_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Bytes_size (Item_t (Nat_t None, rest, annot))
  (* currency operations *)
  | ( Prim (loc, I_ADD, [], annot),
      Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Add_tez (Item_t (Mutez_t tname, rest, annot))
  | ( Prim (loc, I_SUB, [], annot),
      Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Sub_tez (Item_t (Mutez_t tname, rest, annot))
  | ( Prim (loc, I_MUL, [], annot),
      Item_t (Mutez_t tname, Item_t (Nat_t _, rest, _), _) ) ->
      (* no type name check *)
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Mul_teznat (Item_t (Mutez_t tname, rest, annot))
  | ( Prim (loc, I_MUL, [], annot),
      Item_t (Nat_t _, Item_t (Mutez_t tname, rest, _), _) ) ->
      (* no type name check *)
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Mul_nattez (Item_t (Mutez_t tname, rest, annot))
  (* boolean operations *)
  | ( Prim (loc, I_OR, [], annot),
      Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname -> typed ctxt loc Or (Item_t (Bool_t tname, rest, annot))
  | ( Prim (loc, I_AND, [], annot),
      Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname -> typed ctxt loc And (Item_t (Bool_t tname, rest, annot))
  | ( Prim (loc, I_XOR, [], annot),
      Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname -> typed ctxt loc Xor (Item_t (Bool_t tname, rest, annot))
  | (Prim (loc, I_NOT, [], annot), Item_t (Bool_t tname, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot -> typed ctxt loc Not (Item_t (Bool_t tname, rest, annot))
  (* integer operations *)
  | (Prim (loc, I_ABS, [], annot), Item_t (Int_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Abs_int (Item_t (Nat_t None, rest, annot))
  | (Prim (loc, I_ISNAT, [], annot), Item_t (Int_t _, rest, int_annot)) ->
      parse_var_annot loc annot ~default:int_annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Is_nat
        (Item_t (Option_t (Nat_t None, None, false), rest, annot))
  | (Prim (loc, I_INT, [], annot), Item_t (Nat_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Int_nat (Item_t (Int_t None, rest, annot))
  | (Prim (loc, I_NEG, [], annot), Item_t (Int_t tname, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Neg_int (Item_t (Int_t tname, rest, annot))
  | (Prim (loc, I_NEG, [], annot), Item_t (Nat_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Neg_nat (Item_t (Int_t None, rest, annot))
  | ( Prim (loc, I_ADD, [], annot),
      Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Add_intint (Item_t (Int_t tname, rest, annot))
  | ( Prim (loc, I_ADD, [], annot),
      Item_t (Int_t tname, Item_t (Nat_t _, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Add_intnat (Item_t (Int_t tname, rest, annot))
  | ( Prim (loc, I_ADD, [], annot),
      Item_t (Nat_t _, Item_t (Int_t tname, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Add_natint (Item_t (Int_t tname, rest, annot))
  | ( Prim (loc, I_ADD, [], annot),
      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Add_natnat (Item_t (Nat_t tname, rest, annot))
  | ( Prim (loc, I_SUB, [], annot),
      Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Sub_int (Item_t (Int_t tname, rest, annot))
  | ( Prim (loc, I_SUB, [], annot),
      Item_t (Int_t tname, Item_t (Nat_t _, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Sub_int (Item_t (Int_t tname, rest, annot))
  | ( Prim (loc, I_SUB, [], annot),
      Item_t (Nat_t _, Item_t (Int_t tname, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Sub_int (Item_t (Int_t tname, rest, annot))
  | ( Prim (loc, I_SUB, [], annot),
      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun _tname ->
      typed ctxt loc Sub_int (Item_t (Int_t None, rest, annot))
  | ( Prim (loc, I_MUL, [], annot),
      Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Mul_intint (Item_t (Int_t tname, rest, annot))
  | ( Prim (loc, I_MUL, [], annot),
      Item_t (Int_t tname, Item_t (Nat_t _, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Mul_intnat (Item_t (Int_t tname, rest, annot))
  | ( Prim (loc, I_MUL, [], annot),
      Item_t (Nat_t _, Item_t (Int_t tname, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Mul_natint (Item_t (Int_t tname, rest, annot))
  | ( Prim (loc, I_MUL, [], annot),
      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Mul_natnat (Item_t (Nat_t tname, rest, annot))
  | ( Prim (loc, I_EDIV, [], annot),
      Item_t (Mutez_t tname, Item_t (Nat_t _, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Ediv_teznat
        (Item_t
           ( Option_t
               ( Pair_t
                   ( (Mutez_t tname, None, None),
                     (Mutez_t tname, None, None),
                     None,
                     false ),
                 None,
                 false ),
             rest,
             annot ))
  | ( Prim (loc, I_EDIV, [], annot),
      Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed
        ctxt
        loc
        Ediv_tez
        (Item_t
           ( Option_t
               ( Pair_t
                   ( (Nat_t None, None, None),
                     (Mutez_t tname, None, None),
                     None,
                     false ),
                 None,
                 false ),
             rest,
             annot ))
  | ( Prim (loc, I_EDIV, [], annot),
      Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed
        ctxt
        loc
        Ediv_intint
        (Item_t
           ( Option_t
               ( Pair_t
                   ( (Int_t tname, None, None),
                     (Nat_t None, None, None),
                     None,
                     false ),
                 None,
                 false ),
             rest,
             annot ))
  | ( Prim (loc, I_EDIV, [], annot),
      Item_t (Int_t tname, Item_t (Nat_t _, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Ediv_intnat
        (Item_t
           ( Option_t
               ( Pair_t
                   ( (Int_t tname, None, None),
                     (Nat_t None, None, None),
                     None,
                     false ),
                 None,
                 false ),
             rest,
             annot ))
  | ( Prim (loc, I_EDIV, [], annot),
      Item_t (Nat_t tname, Item_t (Int_t _, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Ediv_natint
        (Item_t
           ( Option_t
               ( Pair_t
                   ( (Int_t None, None, None),
                     (Nat_t tname, None, None),
                     None,
                     false ),
                 None,
                 false ),
             rest,
             annot ))
  | ( Prim (loc, I_EDIV, [], annot),
      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed
        ctxt
        loc
        Ediv_natnat
        (Item_t
           ( Option_t
               ( Pair_t
                   ( (Nat_t tname, None, None),
                     (Nat_t tname, None, None),
                     None,
                     false ),
                 None,
                 false ),
             rest,
             annot ))
  | ( Prim (loc, I_LSL, [], annot),
      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Lsl_nat (Item_t (Nat_t tname, rest, annot))
  | ( Prim (loc, I_LSR, [], annot),
      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Lsr_nat (Item_t (Nat_t tname, rest, annot))
  | ( Prim (loc, I_OR, [], annot),
      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Or_nat (Item_t (Nat_t tname, rest, annot))
  | ( Prim (loc, I_AND, [], annot),
      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc And_nat (Item_t (Nat_t tname, rest, annot))
  | ( Prim (loc, I_AND, [], annot),
      Item_t (Int_t _, Item_t (Nat_t tname, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc And_int_nat (Item_t (Nat_t tname, rest, annot))
  | ( Prim (loc, I_XOR, [], annot),
      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      Lwt.return @@ merge_type_annot ~legacy tn1 tn2
      >>=? fun tname ->
      typed ctxt loc Xor_nat (Item_t (Nat_t tname, rest, annot))
  | (Prim (loc, I_NOT, [], annot), Item_t (Int_t tname, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Not_int (Item_t (Int_t tname, rest, annot))
  | (Prim (loc, I_NOT, [], annot), Item_t (Nat_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Not_nat (Item_t (Int_t None, rest, annot))
  (* comparison *)
  | (Prim (loc, I_COMPARE, [], annot), Item_t (t1, Item_t (t2, rest, _), _))
    -> (
      parse_var_annot loc annot
      >>=? fun annot ->
      check_item_ty ctxt t1 t2 loc I_COMPARE 1 2
      >>=? fun (Eq, t, ctxt) ->
      match comparable_ty_of_ty t with
      | None ->
          Lwt.return (serialize_ty_for_error ctxt t)
          >>=? fun (t, _ctxt) -> fail (Comparable_type_expected (loc, t))
      | Some key ->
          typed ctxt loc (Compare key) (Item_t (Int_t None, rest, annot)) )
  (* comparators *)
  | (Prim (loc, I_EQ, [], annot), Item_t (Int_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot -> typed ctxt loc Eq (Item_t (Bool_t None, rest, annot))
  | (Prim (loc, I_NEQ, [], annot), Item_t (Int_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot -> typed ctxt loc Neq (Item_t (Bool_t None, rest, annot))
  | (Prim (loc, I_LT, [], annot), Item_t (Int_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot -> typed ctxt loc Lt (Item_t (Bool_t None, rest, annot))
  | (Prim (loc, I_GT, [], annot), Item_t (Int_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot -> typed ctxt loc Gt (Item_t (Bool_t None, rest, annot))
  | (Prim (loc, I_LE, [], annot), Item_t (Int_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot -> typed ctxt loc Le (Item_t (Bool_t None, rest, annot))
  | (Prim (loc, I_GE, [], annot), Item_t (Int_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot -> typed ctxt loc Ge (Item_t (Bool_t None, rest, annot))
  (* annotations *)
  | (Prim (loc, I_CAST, [cast_t], annot), Item_t (t, stack, item_annot)) ->
      parse_var_annot loc annot ~default:item_annot
      >>=? fun annot ->
      Lwt.return @@ parse_any_ty ctxt ~legacy cast_t
      >>=? fun (Ex_ty cast_t, ctxt) ->
      Lwt.return @@ ty_eq ctxt cast_t t
      >>=? fun (Eq, ctxt) ->
      Lwt.return @@ merge_types ~legacy ctxt loc cast_t t
      >>=? fun (_, ctxt) -> typed ctxt loc Nop (Item_t (cast_t, stack, annot))
  | (Prim (loc, I_RENAME, [], annot), Item_t (t, stack, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      (* can erase annot *)
      typed ctxt loc Nop (Item_t (t, stack, annot))
  (* packing *)
  | (Prim (loc, I_PACK, [], annot), Item_t (t, rest, unpacked_annot)) ->
      Lwt.return
        (check_packable
           ~legacy:true
           (* allow to pack contracts for hash/signature checks *) loc
           t)
      >>=? fun () ->
      parse_var_annot
        loc
        annot
        ~default:(gen_access_annot unpacked_annot default_pack_annot)
      >>=? fun annot ->
      typed ctxt loc (Pack t) (Item_t (Bytes_t None, rest, annot))
  | (Prim (loc, I_UNPACK, [ty], annot), Item_t (Bytes_t _, rest, packed_annot))
    ->
      Lwt.return @@ parse_packable_ty ctxt ~legacy ty
      >>=? fun (Ex_ty t, ctxt) ->
      parse_var_type_annot loc annot
      >>=? fun (annot, ty_name) ->
      let annot =
        default_annot
          annot
          ~default:(gen_access_annot packed_annot default_unpack_annot)
      in
      typed
        ctxt
        loc
        (Unpack t)
        (Item_t
           ( Option_t (t, ty_name, false (* cannot unpack big_maps *)),
             rest,
             annot ))
  (* protocol *)
  | ( Prim (loc, I_ADDRESS, [], annot),
      Item_t (Contract_t _, rest, contract_annot) ) ->
      parse_var_annot
        loc
        annot
        ~default:(gen_access_annot contract_annot default_addr_annot)
      >>=? fun annot ->
      typed ctxt loc Address (Item_t (Address_t None, rest, annot))
  | ( Prim (loc, I_CONTRACT, [ty], annot),
      Item_t (Address_t _, rest, addr_annot) ) ->
      Lwt.return @@ parse_parameter_ty ctxt ~legacy ty
      >>=? fun (Ex_ty t, ctxt) ->
      parse_entrypoint_annot
        loc
        annot
        ~default:(gen_access_annot addr_annot default_contract_annot)
      >>=? fun (annot, entrypoint) ->
      ( Lwt.return
      @@
      match entrypoint with
      | None ->
          Ok "default"
      | Some (`Field_annot "default") ->
          error (Unexpected_annotation loc)
      | Some (`Field_annot entrypoint) ->
          if Compare.Int.(String.length entrypoint > 31) then
            error (Entrypoint_name_too_long entrypoint)
          else Ok entrypoint )
      >>=? fun entrypoint ->
      typed
        ctxt
        loc
        (Contract (t, entrypoint))
        (Item_t (Option_t (Contract_t (t, None), None, false), rest, annot))
  | ( Prim (loc, I_TRANSFER_TOKENS, [], annot),
      Item_t (p, Item_t (Mutez_t _, Item_t (Contract_t (cp, _), rest, _), _), _)
    ) ->
      check_item_ty ctxt p cp loc I_TRANSFER_TOKENS 1 4
      >>=? fun (Eq, _, ctxt) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Transfer_tokens (Item_t (Operation_t None, rest, annot))
  | ( Prim (loc, I_SET_DELEGATE, [], annot),
      Item_t (Option_t (Key_hash_t _, _, _), rest, _) ) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Set_delegate (Item_t (Operation_t None, rest, annot))
  | ( Prim (loc, I_CREATE_ACCOUNT, [], annot),
      Item_t
        ( Key_hash_t _,
          Item_t
            ( Option_t (Key_hash_t _, _, _),
              Item_t (Bool_t _, Item_t (Mutez_t _, rest, _), _),
              _ ),
          _ ) ) ->
      if legacy then
        (* For existing contracts, this instruction is still allowed *)
        parse_two_var_annot loc annot
        >>=? fun (op_annot, addr_annot) ->
        typed
          ctxt
          loc
          Create_account
          (Item_t
             ( Operation_t None,
               Item_t (Address_t None, rest, addr_annot),
               op_annot ))
      else
        (* For new contracts this instruction is not allowed anymore *)
        fail (Deprecated_instruction I_CREATE_ACCOUNT)
  | (Prim (loc, I_IMPLICIT_ACCOUNT, [], annot), Item_t (Key_hash_t _, rest, _))
    ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed
        ctxt
        loc
        Implicit_account
        (Item_t (Contract_t (Unit_t None, None), rest, annot))
  | ( Prim (loc, I_CREATE_CONTRACT, [(Seq _ as code)], annot),
      Item_t
        ( Key_hash_t _,
          Item_t
            ( Option_t (Key_hash_t _, _, _),
              Item_t
                ( Bool_t _,
                  Item_t
                    ( Bool_t _,
                      Item_t (Mutez_t _, Item_t (ginit, rest, _), _),
                      _ ),
                  _ ),
              _ ),
          _ ) ) ->
      if legacy then
        (* For existing contracts, this instruction is still allowed *)
        parse_two_var_annot loc annot
        >>=? fun (op_annot, addr_annot) ->
        let cannonical_code = fst @@ Micheline.extract_locations code in
        Lwt.return @@ parse_toplevel ~legacy cannonical_code
        >>=? fun (arg_type, storage_type, code_field, root_name) ->
        trace
          (Ill_formed_type
             (Some "parameter", cannonical_code, location arg_type))
          (Lwt.return @@ parse_parameter_ty ctxt ~legacy arg_type)
        >>=? fun (Ex_ty arg_type, ctxt) ->
        ( if legacy then Error_monad.return ()
        else Lwt.return (well_formed_entrypoints ~root_name arg_type) )
        >>=? fun () ->
        trace
          (Ill_formed_type
             (Some "storage", cannonical_code, location storage_type))
          (Lwt.return @@ parse_storage_ty ctxt ~legacy storage_type)
        >>=? fun (Ex_ty storage_type, ctxt) ->
        let arg_annot =
          default_annot
            (type_to_var_annot (name_of_ty arg_type))
            ~default:default_param_annot
        in
        let storage_annot =
          default_annot
            (type_to_var_annot (name_of_ty storage_type))
            ~default:default_storage_annot
        in
        let arg_type_full =
          Pair_t
            ( (arg_type, None, arg_annot),
              (storage_type, None, storage_annot),
              None,
              has_big_map arg_type || has_big_map storage_type )
        in
        let ret_type_full =
          Pair_t
            ( (List_t (Operation_t None, None, false), None, None),
              (storage_type, None, None),
              None,
              has_big_map storage_type )
        in
        trace
          (Ill_typed_contract (cannonical_code, []))
          (parse_returning
             (Toplevel
                {
                  storage_type;
                  param_type = arg_type;
                  root_name;
                  legacy_create_contract_literal = true;
                })
             ctxt
             ~legacy
             ?type_logger
             (arg_type_full, None)
             ret_type_full
             code_field)
        >>=? fun ( ( Lam
                       ( { bef = Item_t (arg, Empty_t, _);
                           aft = Item_t (ret, Empty_t, _);
                           _ },
                         _ ) as lambda ),
                   ctxt ) ->
        Lwt.return @@ ty_eq ctxt arg arg_type_full
        >>=? fun (Eq, ctxt) ->
        Lwt.return @@ merge_types ~legacy ctxt loc arg arg_type_full
        >>=? fun (_, ctxt) ->
        Lwt.return @@ ty_eq ctxt ret ret_type_full
        >>=? fun (Eq, ctxt) ->
        Lwt.return @@ merge_types ~legacy ctxt loc ret ret_type_full
        >>=? fun (_, ctxt) ->
        Lwt.return @@ ty_eq ctxt storage_type ginit
        >>=? fun (Eq, ctxt) ->
        Lwt.return @@ merge_types ~legacy ctxt loc storage_type ginit
        >>=? fun (_, ctxt) ->
        typed
          ctxt
          loc
          (Create_contract (storage_type, arg_type, lambda, root_name))
          (Item_t
             ( Operation_t None,
               Item_t (Address_t None, rest, addr_annot),
               op_annot ))
      else
        (* For new contracts this instruction is not allowed anymore *)
        fail (Deprecated_instruction I_CREATE_CONTRACT)
  | ( Prim (loc, I_CREATE_CONTRACT, [(Seq _ as code)], annot),
      (* Removed the instruction's arguments manager, spendable and delegatable *)
    Item_t
      ( Option_t (Key_hash_t _, _, _),
        Item_t (Mutez_t _, Item_t (ginit, rest, _), _),
        _ ) ) ->
      parse_two_var_annot loc annot
      >>=? fun (op_annot, addr_annot) ->
      let cannonical_code = fst @@ Micheline.extract_locations code in
      Lwt.return @@ parse_toplevel ~legacy cannonical_code
      >>=? fun (arg_type, storage_type, code_field, root_name) ->
      trace
        (Ill_formed_type (Some "parameter", cannonical_code, location arg_type))
        (Lwt.return @@ parse_parameter_ty ctxt ~legacy arg_type)
      >>=? fun (Ex_ty arg_type, ctxt) ->
      ( if legacy then Error_monad.return ()
      else Lwt.return (well_formed_entrypoints ~root_name arg_type) )
      >>=? fun () ->
      trace
        (Ill_formed_type
           (Some "storage", cannonical_code, location storage_type))
        (Lwt.return @@ parse_storage_ty ctxt ~legacy storage_type)
      >>=? fun (Ex_ty storage_type, ctxt) ->
      let arg_annot =
        default_annot
          (type_to_var_annot (name_of_ty arg_type))
          ~default:default_param_annot
      in
      let storage_annot =
        default_annot
          (type_to_var_annot (name_of_ty storage_type))
          ~default:default_storage_annot
      in
      let arg_type_full =
        Pair_t
          ( (arg_type, None, arg_annot),
            (storage_type, None, storage_annot),
            None,
            has_big_map arg_type || has_big_map storage_type )
      in
      let ret_type_full =
        Pair_t
          ( (List_t (Operation_t None, None, false), None, None),
            (storage_type, None, None),
            None,
            has_big_map storage_type )
      in
      trace
        (Ill_typed_contract (cannonical_code, []))
        (parse_returning
           (Toplevel
              {
                storage_type;
                param_type = arg_type;
                root_name;
                legacy_create_contract_literal = false;
              })
           ctxt
           ~legacy
           ?type_logger
           (arg_type_full, None)
           ret_type_full
           code_field)
      >>=? fun ( ( Lam
                     ( { bef = Item_t (arg, Empty_t, _);
                         aft = Item_t (ret, Empty_t, _);
                         _ },
                       _ ) as lambda ),
                 ctxt ) ->
      Lwt.return @@ ty_eq ctxt arg arg_type_full
      >>=? fun (Eq, ctxt) ->
      Lwt.return @@ merge_types ~legacy ctxt loc arg arg_type_full
      >>=? fun (_, ctxt) ->
      Lwt.return @@ ty_eq ctxt ret ret_type_full
      >>=? fun (Eq, ctxt) ->
      Lwt.return @@ merge_types ~legacy ctxt loc ret ret_type_full
      >>=? fun (_, ctxt) ->
      Lwt.return @@ ty_eq ctxt storage_type ginit
      >>=? fun (Eq, ctxt) ->
      Lwt.return @@ merge_types ~legacy ctxt loc storage_type ginit
      >>=? fun (_, ctxt) ->
      typed
        ctxt
        loc
        (Create_contract_2 (storage_type, arg_type, lambda, root_name))
        (Item_t
           ( Operation_t None,
             Item_t (Address_t None, rest, addr_annot),
             op_annot ))
  | (Prim (loc, I_NOW, [], annot), stack) ->
      parse_var_annot loc annot ~default:default_now_annot
      >>=? fun annot ->
      typed ctxt loc Now (Item_t (Timestamp_t None, stack, annot))
  | (Prim (loc, I_AMOUNT, [], annot), stack) ->
      parse_var_annot loc annot ~default:default_amount_annot
      >>=? fun annot ->
      typed ctxt loc Amount (Item_t (Mutez_t None, stack, annot))
  | (Prim (loc, I_CHAIN_ID, [], annot), stack) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc ChainId (Item_t (Chain_id_t None, stack, annot))
  | (Prim (loc, I_BALANCE, [], annot), stack) ->
      parse_var_annot loc annot ~default:default_balance_annot
      >>=? fun annot ->
      typed ctxt loc Balance (Item_t (Mutez_t None, stack, annot))
  | (Prim (loc, I_HASH_KEY, [], annot), Item_t (Key_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Hash_key (Item_t (Key_hash_t None, rest, annot))
  | ( Prim (loc, I_CHECK_SIGNATURE, [], annot),
      Item_t
        (Key_t _, Item_t (Signature_t _, Item_t (Bytes_t _, rest, _), _), _) )
    ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Check_signature (Item_t (Bool_t None, rest, annot))
  | (Prim (loc, I_BLAKE2B, [], annot), Item_t (Bytes_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Blake2b (Item_t (Bytes_t None, rest, annot))
  | (Prim (loc, I_SHA256, [], annot), Item_t (Bytes_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Sha256 (Item_t (Bytes_t None, rest, annot))
  | (Prim (loc, I_SHA512, [], annot), Item_t (Bytes_t _, rest, _)) ->
      parse_var_annot loc annot
      >>=? fun annot ->
      typed ctxt loc Sha512 (Item_t (Bytes_t None, rest, annot))
  | (Prim (loc, I_STEPS_TO_QUOTA, [], annot), stack) ->
      if legacy then
        (* For existing contracts, this instruction is still allowed *)
        parse_var_annot loc annot ~default:default_steps_annot
        >>=? fun annot ->
        typed ctxt loc Steps_to_quota (Item_t (Nat_t None, stack, annot))
      else
        (* For new contracts this instruction is not allowed anymore *)
        fail (Deprecated_instruction I_STEPS_TO_QUOTA)
  | (Prim (loc, I_SOURCE, [], annot), stack) ->
      parse_var_annot loc annot ~default:default_source_annot
      >>=? fun annot ->
      typed ctxt loc Source (Item_t (Address_t None, stack, annot))
  | (Prim (loc, I_SENDER, [], annot), stack) ->
      parse_var_annot loc annot ~default:default_sender_annot
      >>=? fun annot ->
      typed ctxt loc Sender (Item_t (Address_t None, stack, annot))
  | (Prim (loc, I_SELF, [], annot), stack) ->
      parse_entrypoint_annot loc annot ~default:default_self_annot
      >>=? fun (annot, entrypoint) ->
      let entrypoint =
        Option.unopt_map
          ~f:(fun (`Field_annot annot) -> annot)
          ~default:"default"
          entrypoint
      in
      let rec get_toplevel_type :
          tc_context -> (bef judgement * context) tzresult Lwt.t = function
        | Lambda ->
            fail (Self_in_lambda loc)
        | Dip (_, prev) ->
            get_toplevel_type prev
        | Toplevel
            {param_type; root_name; legacy_create_contract_literal = false} ->
            Lwt.return (find_entrypoint param_type ~root_name entrypoint)
            >>=? fun (_, Ex_ty param_type) ->
            typed
              ctxt
              loc
              (Self (param_type, entrypoint))
              (Item_t (Contract_t (param_type, None), stack, annot))
        | Toplevel
            {param_type; root_name = _; legacy_create_contract_literal = true}
          ->
            typed
              ctxt
              loc
              (Self (param_type, "default"))
              (Item_t (Contract_t (param_type, None), stack, annot))
      in
      get_toplevel_type tc_context
  (* Primitive parsing errors *)
  | ( Prim
        ( loc,
          ( ( I_DUP
            | I_SWAP
            | I_SOME
            | I_UNIT
            | I_PAIR
            | I_CAR
            | I_CDR
            | I_CONS
            | I_CONCAT
            | I_SLICE
            | I_MEM
            | I_UPDATE
            | I_MAP
            | I_GET
            | I_EXEC
            | I_FAILWITH
            | I_SIZE
            | I_ADD
            | I_SUB
            | I_MUL
            | I_EDIV
            | I_OR
            | I_AND
            | I_XOR
            | I_NOT
            | I_ABS
            | I_NEG
            | I_LSL
            | I_LSR
            | I_COMPARE
            | I_EQ
            | I_NEQ
            | I_LT
            | I_GT
            | I_LE
            | I_GE
            | I_TRANSFER_TOKENS
            | I_CREATE_ACCOUNT
            | I_SET_DELEGATE
            | I_NOW
            | I_IMPLICIT_ACCOUNT
            | I_AMOUNT
            | I_BALANCE
            | I_CHECK_SIGNATURE
            | I_HASH_KEY
            | I_SOURCE
            | I_SENDER
            | I_BLAKE2B
            | I_SHA256
            | I_SHA512
            | I_STEPS_TO_QUOTA
            | I_ADDRESS ) as name ),
          (_ :: _ as l),
          _ ),
      _ ) ->
      fail (Invalid_arity (loc, name, 0, List.length l))
  | ( Prim
        ( loc,
          ( ( I_NONE
            | I_LEFT
            | I_RIGHT
            | I_NIL
            | I_MAP
            | I_ITER
            | I_EMPTY_SET
            | I_DIP
            | I_LOOP
            | I_LOOP_LEFT
            | I_CONTRACT ) as name ),
          (([] | _ :: _ :: _) as l),
          _ ),
      _ ) ->
      fail (Invalid_arity (loc, name, 1, List.length l))
  | ( Prim
        ( loc,
          ( (I_PUSH | I_IF_NONE | I_IF_LEFT | I_IF_CONS | I_EMPTY_MAP | I_IF)
          as name ),
          (([] | [_] | _ :: _ :: _ :: _) as l),
          _ ),
      _ ) ->
      fail (Invalid_arity (loc, name, 2, List.length l))
  | (Prim (loc, I_LAMBDA, (([] | [_] | _ :: _ :: _ :: _ :: _) as l), _), _) ->
      fail (Invalid_arity (loc, I_LAMBDA, 3, List.length l))
  (* Stack errors *)
  | ( Prim
        ( loc,
          ( ( I_ADD
            | I_SUB
            | I_MUL
            | I_EDIV
            | I_AND
            | I_OR
            | I_XOR
            | I_LSL
            | I_LSR ) as name ),
          [],
          _ ),
      Item_t (ta, Item_t (tb, _, _), _) ) ->
      Lwt.return @@ serialize_ty_for_error ctxt ta
      >>=? fun (ta, ctxt) ->
      Lwt.return @@ serialize_ty_for_error ctxt tb
      >>=? fun (tb, _ctxt) -> fail (Undefined_binop (loc, name, ta, tb))
  | ( Prim
        ( loc,
          ( ( I_NEG
            | I_ABS
            | I_NOT
            | I_CONCAT
            | I_SIZE
            | I_EQ
            | I_NEQ
            | I_LT
            | I_GT
            | I_LE
            | I_GE ) as name ),
          [],
          _ ),
      Item_t (t, _, _) ) ->
      Lwt.return @@ serialize_ty_for_error ctxt t
      >>=? fun (t, _ctxt) -> fail (Undefined_unop (loc, name, t))
  | (Prim (loc, ((I_UPDATE | I_SLICE) as name), [], _), stack) ->
      serialize_stack_for_error ctxt stack
      >>=? fun (stack, _ctxt) -> fail (Bad_stack (loc, name, 3, stack))
  | (Prim (loc, I_CREATE_CONTRACT, _, _), stack) ->
      serialize_stack_for_error ctxt stack
      >>=? fun (stack, _ctxt) ->
      fail (Bad_stack (loc, I_CREATE_CONTRACT, 7, stack))
  | (Prim (loc, I_CREATE_ACCOUNT, [], _), stack) ->
      serialize_stack_for_error ctxt stack
      >>=? fun (stack, _ctxt) ->
      fail (Bad_stack (loc, I_CREATE_ACCOUNT, 4, stack))
  | (Prim (loc, I_TRANSFER_TOKENS, [], _), stack) ->
      serialize_stack_for_error ctxt stack
      >>=? fun (stack, _ctxt) ->
      fail (Bad_stack (loc, I_TRANSFER_TOKENS, 4, stack))
  | ( Prim
        ( loc,
          ( ( I_DROP
            | I_DUP
            | I_CAR
            | I_CDR
            | I_SOME
            | I_BLAKE2B
            | I_SHA256
            | I_SHA512
            | I_DIP
            | I_IF_NONE
            | I_LEFT
            | I_RIGHT
            | I_IF_LEFT
            | I_IF
            | I_LOOP
            | I_IF_CONS
            | I_IMPLICIT_ACCOUNT
            | I_NEG
            | I_ABS
            | I_INT
            | I_NOT
            | I_HASH_KEY
            | I_EQ
            | I_NEQ
            | I_LT
            | I_GT
            | I_LE
            | I_GE ) as name ),
          _,
          _ ),
      stack ) ->
      serialize_stack_for_error ctxt stack
      >>=? fun (stack, _ctxt) -> fail (Bad_stack (loc, name, 1, stack))
  | ( Prim
        ( loc,
          ( ( I_SWAP
            | I_PAIR
            | I_CONS
            | I_GET
            | I_MEM
            | I_EXEC
            | I_CHECK_SIGNATURE
            | I_ADD
            | I_SUB
            | I_MUL
            | I_EDIV
            | I_AND
            | I_OR
            | I_XOR
            | I_LSL
            | I_LSR ) as name ),
          _,
          _ ),
      stack ) ->
      serialize_stack_for_error ctxt stack
      >>=? fun (stack, _ctxt) -> fail (Bad_stack (loc, name, 2, stack))
  (* Generic parsing errors *)
  | (expr, _) ->
      fail
      @@ unexpected
           expr
           [Seq_kind]
           Instr_namespace
           [ I_DROP;
             I_DUP;
             I_DIG;
             I_DUG;
             I_SWAP;
             I_SOME;
             I_UNIT;
             I_PAIR;
             I_CAR;
             I_CDR;
             I_CONS;
             I_MEM;
             I_UPDATE;
             I_MAP;
             I_ITER;
             I_GET;
             I_EXEC;
             I_FAILWITH;
             I_SIZE;
             I_CONCAT;
             I_ADD;
             I_SUB;
             I_MUL;
             I_EDIV;
             I_OR;
             I_AND;
             I_XOR;
             I_NOT;
             I_ABS;
             I_INT;
             I_NEG;
             I_LSL;
             I_LSR;
             I_COMPARE;
             I_EQ;
             I_NEQ;
             I_LT;
             I_GT;
             I_LE;
             I_GE;
             I_TRANSFER_TOKENS;
             I_CREATE_ACCOUNT;
             I_CREATE_CONTRACT;
             I_NOW;
             I_AMOUNT;
             I_BALANCE;
             I_IMPLICIT_ACCOUNT;
             I_CHECK_SIGNATURE;
             I_BLAKE2B;
             I_SHA256;
             I_SHA512;
             I_HASH_KEY;
             I_STEPS_TO_QUOTA;
             I_PUSH;
             I_NONE;
             I_LEFT;
             I_RIGHT;
             I_NIL;
             I_EMPTY_SET;
             I_DIP;
             I_LOOP;
             I_IF_NONE;
             I_IF_LEFT;
             I_IF_CONS;
             I_EMPTY_MAP;
             I_IF;
             I_SOURCE;
             I_SENDER;
             I_SELF;
             I_LAMBDA ]

and parse_contract :
    type arg.
    legacy:bool ->
    context ->
    Script.location ->
    arg ty ->
    Contract.t ->
    entrypoint:string ->
    (context * arg typed_contract) tzresult Lwt.t =
 fun ~legacy ctxt loc arg contract ~entrypoint ->
  Lwt.return @@ Gas.consume ctxt Typecheck_costs.contract_exists
  >>=? fun ctxt ->
  Contract.exists ctxt contract
  >>=? function
  | false ->
      fail (Invalid_contract (loc, contract))
  | true -> (
      Lwt.return @@ Gas.consume ctxt Typecheck_costs.get_script
      >>=? fun ctxt ->
      trace (Invalid_contract (loc, contract))
      @@ Contract.get_script_code ctxt contract
      >>=? fun (ctxt, code) ->
      match code with
      | None ->
          Lwt.return
            ( ty_eq ctxt arg (Unit_t None)
            >>? fun (Eq, ctxt) ->
            match entrypoint with
            | "default" ->
                let contract : arg typed_contract =
                  (arg, (contract, entrypoint))
                in
                ok (ctxt, contract)
            | entrypoint ->
                error (No_such_entrypoint entrypoint) )
      | Some code ->
          Script.force_decode ctxt code
          >>=? fun (code, ctxt) ->
          Lwt.return
            ( parse_toplevel ~legacy:true code
            >>? fun (arg_type, _, _, root_name) ->
            parse_parameter_ty ctxt ~legacy:true arg_type
            >>? fun (Ex_ty targ, ctxt) ->
            let return ctxt targ entrypoint =
              merge_types ~legacy ctxt loc targ arg
              >>? fun (arg, ctxt) ->
              let contract : arg typed_contract =
                (arg, (contract, entrypoint))
              in
              ok (ctxt, contract)
            in
            find_entrypoint_for_type
              ~full:targ
              ~expected:arg
              ~root_name
              entrypoint
              ctxt
            >>? fun (ctxt, entrypoint, targ) ->
            merge_types ~legacy ctxt loc targ arg
            >>? fun (targ, ctxt) -> return ctxt targ entrypoint ) )

(* Same as the one above, but does not fail when the contact is missing or
   if the expected type doesn't match the actual one. In that case None is
   returned and some overapproximation of the typechecking gas is consumed.
   This can still fail on gas exhaustion. *)
and parse_contract_for_script :
    type arg.
    legacy:bool ->
    context ->
    Script.location ->
    arg ty ->
    Contract.t ->
    entrypoint:string ->
    (context * arg typed_contract option) tzresult Lwt.t =
 fun ~legacy ctxt loc arg contract ~entrypoint ->
  Lwt.return @@ Gas.consume ctxt Typecheck_costs.contract_exists
  >>=? fun ctxt ->
  Contract.exists ctxt contract
  >>=? function
  | false ->
      return (ctxt, None)
  | true -> (
      Lwt.return @@ Gas.consume ctxt Typecheck_costs.get_script
      >>=? fun ctxt ->
      trace (Invalid_contract (loc, contract))
      @@ Contract.get_script_code ctxt contract
      >>=? fun (ctxt, code) ->
      match code with
      (* can only fail because of gas *)
      | None -> (
        match entrypoint with
        | "default" ->
            Lwt.return
              ( match ty_eq ctxt arg (Unit_t None) with
              | Ok (Eq, ctxt) ->
                  let contract : arg typed_contract =
                    (arg, (contract, entrypoint))
                  in
                  ok (ctxt, Some contract)
              | Error _ ->
                  Gas.consume ctxt Typecheck_costs.cycle
                  >>? fun ctxt -> ok (ctxt, None) )
        | _ ->
            return (ctxt, None) )
      | Some code ->
          Script.force_decode ctxt code
          >>=? fun (code, ctxt) ->
          (* can only fail because of gas *)
          Lwt.return
            ( match parse_toplevel ~legacy:true code with
            | Error _ ->
                error (Invalid_contract (loc, contract))
            | Ok (arg_type, _, _, root_name) -> (
              match parse_parameter_ty ctxt ~legacy:true arg_type with
              | Error _ ->
                  error (Invalid_contract (loc, contract))
              | Ok (Ex_ty targ, ctxt) -> (
                match
                  find_entrypoint_for_type
                    ~full:targ
                    ~expected:arg
                    ~root_name
                    entrypoint
                    ctxt
                  >>? fun (ctxt, entrypoint, targ) ->
                  merge_types ~legacy ctxt loc targ arg
                  >>? fun (targ, ctxt) ->
                  merge_types ~legacy ctxt loc targ arg
                  >>? fun (arg, ctxt) ->
                  let contract : arg typed_contract =
                    (arg, (contract, entrypoint))
                  in
                  ok (ctxt, Some contract)
                with
                | Ok res ->
                    ok res
                | Error _ ->
                    (* overapproximation by checking if targ = targ,
                                                       can only fail because of gas *)
                    ty_eq ctxt targ targ
                    >>? fun (Eq, ctxt) ->
                    merge_types ~legacy ctxt loc targ targ
                    >>? fun (_, ctxt) -> ok (ctxt, None) ) ) ) )

and parse_toplevel :
    legacy:bool ->
    Script.expr ->
    (Script.node * Script.node * Script.node * string option) tzresult =
 fun ~legacy toplevel ->
  record_trace (Ill_typed_contract (toplevel, []))
  @@
  match root toplevel with
  | Int (loc, _) ->
      error (Invalid_kind (loc, [Seq_kind], Int_kind))
  | String (loc, _) ->
      error (Invalid_kind (loc, [Seq_kind], String_kind))
  | Bytes (loc, _) ->
      error (Invalid_kind (loc, [Seq_kind], Bytes_kind))
  | Prim (loc, _, _, _) ->
      error (Invalid_kind (loc, [Seq_kind], Prim_kind))
  | Seq (_, fields) -> (
      let rec find_fields p s c fields =
        match fields with
        | [] ->
            ok (p, s, c)
        | Int (loc, _) :: _ ->
            error (Invalid_kind (loc, [Prim_kind], Int_kind))
        | String (loc, _) :: _ ->
            error (Invalid_kind (loc, [Prim_kind], String_kind))
        | Bytes (loc, _) :: _ ->
            error (Invalid_kind (loc, [Prim_kind], Bytes_kind))
        | Seq (loc, _) :: _ ->
            error (Invalid_kind (loc, [Prim_kind], Seq_kind))
        | Prim (loc, K_parameter, [arg], annot) :: rest -> (
          match p with
          | None ->
              find_fields (Some (arg, loc, annot)) s c rest
          | Some _ ->
              error (Duplicate_field (loc, K_parameter)) )
        | Prim (loc, K_storage, [arg], annot) :: rest -> (
          match s with
          | None ->
              find_fields p (Some (arg, loc, annot)) c rest
          | Some _ ->
              error (Duplicate_field (loc, K_storage)) )
        | Prim (loc, K_code, [arg], annot) :: rest -> (
          match c with
          | None ->
              find_fields p s (Some (arg, loc, annot)) rest
          | Some _ ->
              error (Duplicate_field (loc, K_code)) )
        | Prim (loc, ((K_parameter | K_storage | K_code) as name), args, _)
          :: _ ->
            error (Invalid_arity (loc, name, 1, List.length args))
        | Prim (loc, name, _, _) :: _ ->
            let allowed = [K_parameter; K_storage; K_code] in
            error (Invalid_primitive (loc, allowed, name))
      in
      find_fields None None None fields
      >>? function
      | (None, _, _) ->
          error (Missing_field K_parameter)
      | (Some _, None, _) ->
          error (Missing_field K_storage)
      | (Some _, Some _, None) ->
          error (Missing_field K_code)
      | (Some (p, ploc, pannot), Some (s, sloc, sannot), Some (c, cloc, carrot))
        ->
          let maybe_root_name =
            (* root name can be attached to either the parameter
                 primitive or the toplevel constructor *)
            Script_ir_annot.extract_field_annot p
            >>? fun (p, root_name) ->
            match root_name with
            | Some (`Field_annot root_name) ->
                ok (p, pannot, Some root_name)
            | None -> (
              match pannot with
              | [single]
                when Compare.Int.(String.length single > 0)
                     && Compare.Char.(single.[0] = '%') ->
                  ok
                    ( p,
                      [],
                      Some (String.sub single 1 (String.length single - 1)) )
              | _ ->
                  ok (p, pannot, None) )
          in
          if legacy then
            (* legacy semantics ignores spurious annotations *)
            let (p, root_name) =
              match maybe_root_name with
              | Ok (p, _, root_name) ->
                  (p, root_name)
              | Error _ ->
                  (p, None)
            in
            ok (p, s, c, root_name)
          else
            (* only one field annot is allowed to set the root entrypoint name *)
            maybe_root_name
            >>? fun (p, pannot, root_name) ->
            Script_ir_annot.error_unexpected_annot ploc pannot
            >>? fun () ->
            Script_ir_annot.error_unexpected_annot cloc carrot
            >>? fun () ->
            Script_ir_annot.error_unexpected_annot sloc sannot
            >>? fun () -> ok (p, s, c, root_name) )

let parse_script :
    ?type_logger:type_logger ->
    context ->
    legacy:bool ->
    Script.t ->
    (ex_script * context) tzresult Lwt.t =
 fun ?type_logger ctxt ~legacy {code; storage} ->
  Script.force_decode ctxt code
  >>=? fun (code, ctxt) ->
  Script.force_decode ctxt storage
  >>=? fun (storage, ctxt) ->
  Lwt.return @@ parse_toplevel ~legacy code
  >>=? fun (arg_type, storage_type, code_field, root_name) ->
  trace
    (Ill_formed_type (Some "parameter", code, location arg_type))
    (Lwt.return (parse_parameter_ty ctxt ~legacy arg_type))
  >>=? fun (Ex_ty arg_type, ctxt) ->
  ( if legacy then return ()
  else Lwt.return (well_formed_entrypoints ~root_name arg_type) )
  >>=? fun () ->
  trace
    (Ill_formed_type (Some "storage", code, location storage_type))
    (Lwt.return (parse_storage_ty ctxt ~legacy storage_type))
  >>=? fun (Ex_ty storage_type, ctxt) ->
  let arg_annot =
    default_annot
      (type_to_var_annot (name_of_ty arg_type))
      ~default:default_param_annot
  in
  let storage_annot =
    default_annot
      (type_to_var_annot (name_of_ty storage_type))
      ~default:default_storage_annot
  in
  let arg_type_full =
    Pair_t
      ( (arg_type, None, arg_annot),
        (storage_type, None, storage_annot),
        None,
        has_big_map arg_type || has_big_map storage_type )
  in
  let ret_type_full =
    Pair_t
      ( (List_t (Operation_t None, None, false), None, None),
        (storage_type, None, None),
        None,
        has_big_map storage_type )
  in
  trace_eval
    (fun () ->
      Lwt.return @@ serialize_ty_for_error ctxt storage_type
      >>|? fun (storage_type, _ctxt) ->
      Ill_typed_data (None, storage, storage_type))
    (parse_data ?type_logger ctxt ~legacy storage_type (root storage))
  >>=? fun (storage, ctxt) ->
  trace
    (Ill_typed_contract (code, []))
    (parse_returning
       (Toplevel
          {
            storage_type;
            param_type = arg_type;
            root_name;
            legacy_create_contract_literal = false;
          })
       ctxt
       ~legacy
       ?type_logger
       (arg_type_full, None)
       ret_type_full
       code_field)
  >>=? fun (code, ctxt) ->
  return (Ex_script {code; arg_type; storage; storage_type; root_name}, ctxt)

let typecheck_code :
    context -> Script.expr -> (type_map * context) tzresult Lwt.t =
 fun ctxt code ->
  let legacy = false in
  Lwt.return @@ parse_toplevel ~legacy code
  >>=? fun (arg_type, storage_type, code_field, root_name) ->
  let type_map = ref [] in
  trace
    (Ill_formed_type (Some "parameter", code, location arg_type))
    (Lwt.return (parse_parameter_ty ctxt ~legacy arg_type))
  >>=? fun (Ex_ty arg_type, ctxt) ->
  ( if legacy then return ()
  else Lwt.return (well_formed_entrypoints ~root_name arg_type) )
  >>=? fun () ->
  trace
    (Ill_formed_type (Some "storage", code, location storage_type))
    (Lwt.return (parse_storage_ty ctxt ~legacy storage_type))
  >>=? fun (Ex_ty storage_type, ctxt) ->
  let arg_annot =
    default_annot
      (type_to_var_annot (name_of_ty arg_type))
      ~default:default_param_annot
  in
  let storage_annot =
    default_annot
      (type_to_var_annot (name_of_ty storage_type))
      ~default:default_storage_annot
  in
  let arg_type_full =
    Pair_t
      ( (arg_type, None, arg_annot),
        (storage_type, None, storage_annot),
        None,
        has_big_map arg_type || has_big_map storage_type )
  in
  let ret_type_full =
    Pair_t
      ( (List_t (Operation_t None, None, false), None, None),
        (storage_type, None, None),
        None,
        has_big_map storage_type )
  in
  let result =
    parse_returning
      (Toplevel
         {
           storage_type;
           param_type = arg_type;
           root_name;
           legacy_create_contract_literal = false;
         })
      ctxt
      ~legacy
      ~type_logger:(fun loc bef aft ->
        type_map := (loc, (bef, aft)) :: !type_map)
      (arg_type_full, None)
      ret_type_full
      code_field
  in
  trace (Ill_typed_contract (code, !type_map)) result
  >>=? fun (Lam _, ctxt) -> return (!type_map, ctxt)

let typecheck_data :
    ?type_logger:type_logger ->
    context ->
    Script.expr * Script.expr ->
    context tzresult Lwt.t =
 fun ?type_logger ctxt (data, exp_ty) ->
  let legacy = false in
  trace
    (Ill_formed_type (None, exp_ty, 0))
    (Lwt.return @@ parse_packable_ty ctxt ~legacy (root exp_ty))
  >>=? fun (Ex_ty exp_ty, ctxt) ->
  trace_eval
    (fun () ->
      Lwt.return @@ serialize_ty_for_error ctxt exp_ty
      >>|? fun (exp_ty, _ctxt) -> Ill_typed_data (None, data, exp_ty))
    (parse_data ?type_logger ctxt ~legacy exp_ty (root data))
  >>=? fun (_, ctxt) -> return ctxt

module Entrypoints_map = Map.Make (String)

let list_entrypoints (type full) (full : full ty) ctxt ~root_name =
  let merge path annot (type t) (ty : t ty) reachable
      ((unreachables, all) as acc) =
    match annot with
    | None | Some (`Field_annot "") -> (
        ok
        @@
        if reachable then acc
        else
          match ty with
          | Union_t _ ->
              acc
          | _ ->
              (List.rev path :: unreachables, all) )
    | Some (`Field_annot name) ->
        if Compare.Int.(String.length name > 31) then
          ok (List.rev path :: unreachables, all)
        else if Entrypoints_map.mem name all then
          ok (List.rev path :: unreachables, all)
        else
          unparse_ty_no_lwt ctxt ty
          >>? fun (unparsed_ty, _) ->
          ok
            ( unreachables,
              Entrypoints_map.add name (List.rev path, unparsed_ty) all )
  in
  let rec fold_tree :
      type t.
      t ty ->
      prim list ->
      bool ->
      prim list list * (prim list * Script.node) Entrypoints_map.t ->
      (prim list list * (prim list * Script.node) Entrypoints_map.t) tzresult =
   fun t path reachable acc ->
    match t with
    | Union_t ((tl, al), (tr, ar), _, _) ->
        merge (D_Left :: path) al tl reachable acc
        >>? fun acc ->
        merge (D_Right :: path) ar tr reachable acc
        >>? fun acc ->
        fold_tree
          tl
          (D_Left :: path)
          (match al with Some _ -> true | None -> reachable)
          acc
        >>? fun acc ->
        fold_tree
          tr
          (D_Right :: path)
          (match ar with Some _ -> true | None -> reachable)
          acc
    | _ ->
        ok acc
  in
  unparse_ty_no_lwt ctxt full
  >>? fun (unparsed_full, _) ->
  let (init, reachable) =
    match root_name with
    | None | Some "" ->
        (Entrypoints_map.empty, false)
    | Some name ->
        (Entrypoints_map.singleton name ([], unparsed_full), true)
  in
  fold_tree full [] reachable ([], init)

(* ---- Unparsing (Typed IR -> Untyped expressions) --------------------------*)

let rec unparse_data :
    type a.
    context ->
    unparsing_mode ->
    a ty ->
    a ->
    (Script.node * context) tzresult Lwt.t =
 fun ctxt mode ty a ->
  Lwt.return (Gas.consume ctxt Unparse_costs.cycle)
  >>=? fun ctxt ->
  match (ty, a) with
  | (Unit_t _, ()) ->
      Lwt.return (Gas.consume ctxt Unparse_costs.unit)
      >>=? fun ctxt -> return (Prim (-1, D_Unit, [], []), ctxt)
  | (Int_t _, v) ->
      Lwt.return (Gas.consume ctxt (Unparse_costs.int v))
      >>=? fun ctxt -> return (Int (-1, Script_int.to_zint v), ctxt)
  | (Nat_t _, v) ->
      Lwt.return (Gas.consume ctxt (Unparse_costs.int v))
      >>=? fun ctxt -> return (Int (-1, Script_int.to_zint v), ctxt)
  | (String_t _, s) ->
      Lwt.return (Gas.consume ctxt (Unparse_costs.string s))
      >>=? fun ctxt -> return (String (-1, s), ctxt)
  | (Bytes_t _, s) ->
      Lwt.return (Gas.consume ctxt (Unparse_costs.bytes s))
      >>=? fun ctxt -> return (Bytes (-1, s), ctxt)
  | (Bool_t _, true) ->
      Lwt.return (Gas.consume ctxt Unparse_costs.bool)
      >>=? fun ctxt -> return (Prim (-1, D_True, [], []), ctxt)
  | (Bool_t _, false) ->
      Lwt.return (Gas.consume ctxt Unparse_costs.bool)
      >>=? fun ctxt -> return (Prim (-1, D_False, [], []), ctxt)
  | (Timestamp_t _, t) -> (
      Lwt.return (Gas.consume ctxt (Unparse_costs.timestamp t))
      >>=? fun ctxt ->
      match mode with
      | Optimized ->
          return (Int (-1, Script_timestamp.to_zint t), ctxt)
      | Readable -> (
        match Script_timestamp.to_notation t with
        | None ->
            return (Int (-1, Script_timestamp.to_zint t), ctxt)
        | Some s ->
            return (String (-1, s), ctxt) ) )
  | (Address_t _, (c, entrypoint)) -> (
      Lwt.return (Gas.consume ctxt Unparse_costs.contract)
      >>=? fun ctxt ->
      match mode with
      | Optimized ->
          let entrypoint =
            match entrypoint with "default" -> "" | name -> name
          in
          let bytes =
            Data_encoding.Binary.to_bytes_exn
              Data_encoding.(tup2 Contract.encoding Variable.string)
              (c, entrypoint)
          in
          return (Bytes (-1, bytes), ctxt)
      | Readable ->
          let notation =
            match entrypoint with
            | "default" ->
                Contract.to_b58check c
            | entrypoint ->
                Contract.to_b58check c ^ "%" ^ entrypoint
          in
          return (String (-1, notation), ctxt) )
  | (Contract_t _, (_, (c, entrypoint))) -> (
      Lwt.return (Gas.consume ctxt Unparse_costs.contract)
      >>=? fun ctxt ->
      match mode with
      | Optimized ->
          let entrypoint =
            match entrypoint with "default" -> "" | name -> name
          in
          let bytes =
            Data_encoding.Binary.to_bytes_exn
              Data_encoding.(tup2 Contract.encoding Variable.string)
              (c, entrypoint)
          in
          return (Bytes (-1, bytes), ctxt)
      | Readable ->
          let notation =
            match entrypoint with
            | "default" ->
                Contract.to_b58check c
            | entrypoint ->
                Contract.to_b58check c ^ "%" ^ entrypoint
          in
          return (String (-1, notation), ctxt) )
  | (Signature_t _, s) -> (
      Lwt.return (Gas.consume ctxt Unparse_costs.signature)
      >>=? fun ctxt ->
      match mode with
      | Optimized ->
          let bytes = Data_encoding.Binary.to_bytes_exn Signature.encoding s in
          return (Bytes (-1, bytes), ctxt)
      | Readable ->
          return (String (-1, Signature.to_b58check s), ctxt) )
  | (Mutez_t _, v) ->
      Lwt.return (Gas.consume ctxt Unparse_costs.tez)
      >>=? fun ctxt -> return (Int (-1, Z.of_int64 (Tez.to_mutez v)), ctxt)
  | (Key_t _, k) -> (
      Lwt.return (Gas.consume ctxt Unparse_costs.key)
      >>=? fun ctxt ->
      match mode with
      | Optimized ->
          let bytes =
            Data_encoding.Binary.to_bytes_exn Signature.Public_key.encoding k
          in
          return (Bytes (-1, bytes), ctxt)
      | Readable ->
          return (String (-1, Signature.Public_key.to_b58check k), ctxt) )
  | (Key_hash_t _, k) -> (
      Lwt.return (Gas.consume ctxt Unparse_costs.key_hash)
      >>=? fun ctxt ->
      match mode with
      | Optimized ->
          let bytes =
            Data_encoding.Binary.to_bytes_exn
              Signature.Public_key_hash.encoding
              k
          in
          return (Bytes (-1, bytes), ctxt)
      | Readable ->
          return (String (-1, Signature.Public_key_hash.to_b58check k), ctxt) )
  | (Operation_t _, (op, _big_map_diff)) ->
      let bytes =
        Data_encoding.Binary.to_bytes_exn
          Operation.internal_operation_encoding
          op
      in
      Lwt.return (Gas.consume ctxt (Unparse_costs.operation bytes))
      >>=? fun ctxt -> return (Bytes (-1, bytes), ctxt)
  | (Chain_id_t _, chain_id) ->
      let bytes =
        Data_encoding.Binary.to_bytes_exn Chain_id.encoding chain_id
      in
      Lwt.return (Gas.consume ctxt (Unparse_costs.chain_id bytes))
      >>=? fun ctxt -> return (Bytes (-1, bytes), ctxt)
  | (Pair_t ((tl, _, _), (tr, _, _), _, _), (l, r)) ->
      Lwt.return (Gas.consume ctxt Unparse_costs.pair)
      >>=? fun ctxt ->
      unparse_data ctxt mode tl l
      >>=? fun (l, ctxt) ->
      unparse_data ctxt mode tr r
      >>=? fun (r, ctxt) -> return (Prim (-1, D_Pair, [l; r], []), ctxt)
  | (Union_t ((tl, _), _, _, _), L l) ->
      Lwt.return (Gas.consume ctxt Unparse_costs.union)
      >>=? fun ctxt ->
      unparse_data ctxt mode tl l
      >>=? fun (l, ctxt) -> return (Prim (-1, D_Left, [l], []), ctxt)
  | (Union_t (_, (tr, _), _, _), R r) ->
      Lwt.return (Gas.consume ctxt Unparse_costs.union)
      >>=? fun ctxt ->
      unparse_data ctxt mode tr r
      >>=? fun (r, ctxt) -> return (Prim (-1, D_Right, [r], []), ctxt)
  | (Option_t (t, _, _), Some v) ->
      Lwt.return (Gas.consume ctxt Unparse_costs.some)
      >>=? fun ctxt ->
      unparse_data ctxt mode t v
      >>=? fun (v, ctxt) -> return (Prim (-1, D_Some, [v], []), ctxt)
  | (Option_t _, None) ->
      Lwt.return (Gas.consume ctxt Unparse_costs.none)
      >>=? fun ctxt -> return (Prim (-1, D_None, [], []), ctxt)
  | (List_t (t, _, _), items) ->
      fold_left_s
        (fun (l, ctxt) element ->
          Lwt.return (Gas.consume ctxt Unparse_costs.list_element)
          >>=? fun ctxt ->
          unparse_data ctxt mode t element
          >>=? fun (unparsed, ctxt) -> return (unparsed :: l, ctxt))
        ([], ctxt)
        items
      >>=? fun (items, ctxt) ->
      return (Micheline.Seq (-1, List.rev items), ctxt)
  | (Set_t (t, _), set) ->
      let t = ty_of_comparable_ty t in
      fold_left_s
        (fun (l, ctxt) item ->
          Lwt.return (Gas.consume ctxt Unparse_costs.set_element)
          >>=? fun ctxt ->
          unparse_data ctxt mode t item
          >>=? fun (item, ctxt) -> return (item :: l, ctxt))
        ([], ctxt)
        (set_fold (fun e acc -> e :: acc) set [])
      >>=? fun (items, ctxt) -> return (Micheline.Seq (-1, items), ctxt)
  | (Map_t (kt, vt, _, _), map) ->
      let kt = ty_of_comparable_ty kt in
      fold_left_s
        (fun (l, ctxt) (k, v) ->
          Lwt.return (Gas.consume ctxt Unparse_costs.map_element)
          >>=? fun ctxt ->
          unparse_data ctxt mode kt k
          >>=? fun (key, ctxt) ->
          unparse_data ctxt mode vt v
          >>=? fun (value, ctxt) ->
          return (Prim (-1, D_Elt, [key; value], []) :: l, ctxt))
        ([], ctxt)
        (map_fold (fun k v acc -> (k, v) :: acc) map [])
      >>=? fun (items, ctxt) -> return (Micheline.Seq (-1, items), ctxt)
  | (Big_map_t (kt, vt, _), {id = None; diff = (module Diff); _}) ->
      (* this branch is to allow roundtrip of big map literals *)
      let kt = ty_of_comparable_ty kt in
      fold_left_s
        (fun (l, ctxt) (k, v) ->
          Lwt.return (Gas.consume ctxt Unparse_costs.map_element)
          >>=? fun ctxt ->
          unparse_data ctxt mode kt k
          >>=? fun (key, ctxt) ->
          unparse_data ctxt mode vt v
          >>=? fun (value, ctxt) ->
          return (Prim (-1, D_Elt, [key; value], []) :: l, ctxt))
        ([], ctxt)
        (Diff.OPS.fold
           (fun k v acc ->
             match v with None -> acc | Some v -> (k, v) :: acc)
           (fst Diff.boxed)
           [])
      >>=? fun (items, ctxt) -> return (Micheline.Seq (-1, items), ctxt)
  | (Big_map_t (_kt, _kv, _), {id = Some id; diff = (module Diff); _}) ->
      if Compare.Int.(Diff.OPS.cardinal (fst Diff.boxed) = 0) then
        return (Micheline.Int (-1, id), ctxt)
      else
        (* this can only be the result of an execution and the map
             must have been flushed at this point *)
        assert false
  | (Lambda_t _, Lam (_, original_code)) ->
      unparse_code ctxt mode original_code

(* Gas accounting may not be perfect in this function, as it is only called by RPCs. *)
and unparse_code ctxt mode =
  let legacy = true in
  function
  | Prim (loc, I_PUSH, [ty; data], annot) ->
      Lwt.return (parse_packable_ty ctxt ~legacy ty)
      >>=? fun (Ex_ty t, ctxt) ->
      parse_data ctxt ~legacy t data
      >>=? fun (data, ctxt) ->
      unparse_data ctxt mode t data
      >>=? fun (data, ctxt) ->
      Lwt.return (Gas.consume ctxt (Unparse_costs.prim_cost 2 annot))
      >>=? fun ctxt -> return (Prim (loc, I_PUSH, [ty; data], annot), ctxt)
  | Seq (loc, items) ->
      fold_left_s
        (fun (l, ctxt) item ->
          unparse_code ctxt mode item
          >>=? fun (item, ctxt) -> return (item :: l, ctxt))
        ([], ctxt)
        items
      >>=? fun (items, ctxt) ->
      Lwt.return
        (Gas.consume ctxt (Unparse_costs.seq_cost (List.length items)))
      >>=? fun ctxt -> return (Micheline.Seq (loc, List.rev items), ctxt)
  | Prim (loc, prim, items, annot) ->
      fold_left_s
        (fun (l, ctxt) item ->
          unparse_code ctxt mode item
          >>=? fun (item, ctxt) -> return (item :: l, ctxt))
        ([], ctxt)
        items
      >>=? fun (items, ctxt) ->
      Lwt.return (Gas.consume ctxt (Unparse_costs.prim_cost 3 annot))
      >>=? fun ctxt -> return (Prim (loc, prim, List.rev items, annot), ctxt)
  | (Int _ | String _ | Bytes _) as atom ->
      return (atom, ctxt)

(* Gas accounting may not be perfect in this function, as it is only called by RPCs. *)
let unparse_script ctxt mode {code; arg_type; storage; storage_type; root_name}
    =
  let (Lam (_, original_code)) = code in
  unparse_code ctxt mode original_code
  >>=? fun (code, ctxt) ->
  unparse_data ctxt mode storage_type storage
  >>=? fun (storage, ctxt) ->
  unparse_ty ctxt arg_type
  >>=? fun (arg_type, ctxt) ->
  unparse_ty ctxt storage_type
  >>=? fun (storage_type, ctxt) ->
  let arg_type =
    add_field_annot
      (Option.map ~f:(fun n -> `Field_annot n) root_name)
      None
      arg_type
  in
  let open Micheline in
  let code =
    Seq
      ( -1,
        [ Prim (-1, K_parameter, [arg_type], []);
          Prim (-1, K_storage, [storage_type], []);
          Prim (-1, K_code, [code], []) ] )
  in
  Lwt.return
    ( Gas.consume ctxt (Unparse_costs.seq_cost 3)
    >>? fun ctxt ->
    Gas.consume ctxt (Unparse_costs.prim_cost 1 [])
    >>? fun ctxt ->
    Gas.consume ctxt (Unparse_costs.prim_cost 1 [])
    >>? fun ctxt -> Gas.consume ctxt (Unparse_costs.prim_cost 1 []) )
  >>=? fun ctxt ->
  return
    ( {
        code = lazy_expr (strip_locations code);
        storage = lazy_expr (strip_locations storage);
      },
      ctxt )

let pack_data ctxt typ data =
  unparse_data ctxt Optimized typ data
  >>=? fun (unparsed, ctxt) ->
  let bytes =
    Data_encoding.Binary.to_bytes_exn
      expr_encoding
      (Micheline.strip_locations unparsed)
  in
  Lwt.return @@ Gas.consume ctxt (Script.serialized_cost bytes)
  >>=? fun ctxt ->
  let bytes = MBytes.concat "" [MBytes.of_string "\005"; bytes] in
  Lwt.return @@ Gas.consume ctxt (Script.serialized_cost bytes)
  >>=? fun ctxt -> return (bytes, ctxt)

let hash_data ctxt typ data =
  pack_data ctxt typ data
  >>=? fun (bytes, ctxt) ->
  Lwt.return
  @@ Gas.consume
       ctxt
       (Michelson_v1_gas.Cost_of.Legacy.hash bytes Script_expr_hash.size)
  >>=? fun ctxt -> return (Script_expr_hash.(hash_bytes [bytes]), ctxt)

(* ---------------- Big map -------------------------------------------------*)

let empty_big_map tk tv =
  {
    id = None;
    diff = empty_map tk;
    key_type = ty_of_comparable_ty tk;
    value_type = tv;
  }

let big_map_mem ctxt key {id; diff; key_type; _} =
  match (map_get key diff, id) with
  | (None, None) ->
      return (false, ctxt)
  | (None, Some id) ->
      hash_data ctxt key_type key
      >>=? fun (hash, ctxt) ->
      Alpha_context.Big_map.mem ctxt id hash
      >>=? fun (ctxt, res) -> return (res, ctxt)
  | (Some None, _) ->
      return (false, ctxt)
  | (Some (Some _), _) ->
      return (true, ctxt)

let big_map_get ctxt key {id; diff; key_type; value_type} =
  match (map_get key diff, id) with
  | (Some x, _) ->
      return (x, ctxt)
  | (None, None) ->
      return (None, ctxt)
  | (None, Some id) -> (
      hash_data ctxt key_type key
      >>=? fun (hash, ctxt) ->
      Alpha_context.Big_map.get_opt ctxt id hash
      >>=? function
      | (ctxt, None) ->
          return (None, ctxt)
      | (ctxt, Some value) ->
          parse_data ctxt ~legacy:true value_type (Micheline.root value)
          >>=? fun (x, ctxt) -> return (Some x, ctxt) )

let big_map_update key value ({diff; _} as map) =
  {map with diff = map_set key value diff}

module Ids = Set.Make (Compare.Z)

type big_map_ids = Ids.t

let no_big_map_id = Ids.empty

let diff_of_big_map ctxt fresh mode ~ids {id; key_type; value_type; diff} =
  Lwt.return
    (Gas.consume ctxt (Michelson_v1_gas.Cost_of.Legacy.map_to_list diff))
  >>=? fun ctxt ->
  ( match id with
  | Some id ->
      if Ids.mem id ids then
        fresh ctxt
        >>=? fun (ctxt, duplicate) ->
        return (ctxt, [Contract.Copy (id, duplicate)], duplicate)
      else
        (* The first occurence encountered of a big_map reuses the
             ID. This way, the payer is only charged for the diff.
             For this to work, this diff has to be put at the end of
             the global diff, otherwise the duplicates will use the
             updated version as a base. This is true because we add
             this diff first in the accumulator of
             `extract_big_map_updates`, and this accumulator is not
             reversed before being flattened. *)
        return (ctxt, [], id)
  | None ->
      fresh ctxt
      >>=? fun (ctxt, id) ->
      unparse_ty ctxt key_type
      >>=? fun (kt, ctxt) ->
      unparse_ty ctxt value_type
      >>=? fun (kv, ctxt) ->
      return
        ( ctxt,
          [ Contract.Alloc
              {
                big_map = id;
                key_type = Micheline.strip_locations kt;
                value_type = Micheline.strip_locations kv;
              } ],
          id ) )
  >>=? fun (ctxt, init, big_map) ->
  let pairs = map_fold (fun key value acc -> (key, value) :: acc) diff [] in
  fold_left_s
    (fun (acc, ctxt) (key, value) ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.cycle)
      >>=? fun ctxt ->
      hash_data ctxt key_type key
      >>=? fun (diff_key_hash, ctxt) ->
      unparse_data ctxt mode key_type key
      >>=? fun (key_node, ctxt) ->
      let diff_key = Micheline.strip_locations key_node in
      ( match value with
      | None ->
          return (None, ctxt)
      | Some x ->
          unparse_data ctxt mode value_type x
          >>=? fun (node, ctxt) ->
          return (Some (Micheline.strip_locations node), ctxt) )
      >>=? fun (diff_value, ctxt) ->
      let diff_item =
        Contract.Update {big_map; diff_key; diff_key_hash; diff_value}
      in
      return (diff_item :: acc, ctxt))
    ([], ctxt)
    pairs
  >>=? fun (diff, ctxt) -> return (init @ diff, big_map, ctxt)

let rec extract_big_map_updates :
    type a.
    context ->
    (context -> (context * Big_map.id) tzresult Lwt.t) ->
    unparsing_mode ->
    Ids.t ->
    Contract.big_map_diff list ->
    a ty ->
    a ->
    (context * a * Ids.t * Contract.big_map_diff list) tzresult Lwt.t =
 fun ctxt fresh mode ids acc ty x ->
  match (ty, x) with
  | (Big_map_t (_, _, _), map) ->
      diff_of_big_map ctxt fresh mode ids map
      >>=? fun (diff, id, ctxt) ->
      let (module Map) = map.diff in
      let map = {map with diff = empty_map Map.key_ty; id = Some id} in
      return (ctxt, map, Ids.add id ids, diff :: acc)
  | (Pair_t ((tyl, _, _), (tyr, _, _), _, true), (xl, xr)) ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.cycle)
      >>=? fun ctxt ->
      extract_big_map_updates ctxt fresh mode ids acc tyl xl
      >>=? fun (ctxt, xl, ids, acc) ->
      extract_big_map_updates ctxt fresh mode ids acc tyr xr
      >>=? fun (ctxt, xr, ids, acc) -> return (ctxt, (xl, xr), ids, acc)
  | (Union_t ((ty, _), (_, _), _, true), L x) ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.cycle)
      >>=? fun ctxt ->
      extract_big_map_updates ctxt fresh mode ids acc ty x
      >>=? fun (ctxt, x, ids, acc) -> return (ctxt, L x, ids, acc)
  | (Union_t ((_, _), (ty, _), _, true), R x) ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.cycle)
      >>=? fun ctxt ->
      extract_big_map_updates ctxt fresh mode ids acc ty x
      >>=? fun (ctxt, x, ids, acc) -> return (ctxt, R x, ids, acc)
  | (Option_t (ty, _, true), Some x) ->
      Lwt.return (Gas.consume ctxt Typecheck_costs.cycle)
      >>=? fun ctxt ->
      extract_big_map_updates ctxt fresh mode ids acc ty x
      >>=? fun (ctxt, x, ids, acc) -> return (ctxt, Some x, ids, acc)
  | (List_t (ty, _, true), l) ->
      fold_left_s
        (fun (ctxt, l, ids, acc) x ->
          Lwt.return (Gas.consume ctxt Typecheck_costs.cycle)
          >>=? fun ctxt ->
          extract_big_map_updates ctxt fresh mode ids acc ty x
          >>=? fun (ctxt, x, ids, acc) -> return (ctxt, x :: l, ids, acc))
        (ctxt, [], ids, acc)
        l
      >>=? fun (ctxt, l, ids, acc) -> return (ctxt, List.rev l, ids, acc)
  | (Map_t (_, ty, _, true), ((module M) as m)) ->
      Lwt.return
        (Gas.consume ctxt (Michelson_v1_gas.Cost_of.Legacy.map_to_list m))
      >>=? fun ctxt ->
      fold_left_s
        (fun (ctxt, m, ids, acc) (k, x) ->
          Lwt.return (Gas.consume ctxt Typecheck_costs.cycle)
          >>=? fun ctxt ->
          extract_big_map_updates ctxt fresh mode ids acc ty x
          >>=? fun (ctxt, x, ids, acc) ->
          return (ctxt, M.OPS.add k x m, ids, acc))
        (ctxt, M.OPS.empty, ids, acc)
        (M.OPS.bindings (fst M.boxed))
      >>=? fun (ctxt, m, ids, acc) ->
      let module M = struct
        module OPS = M.OPS

        type key = M.key

        type value = M.value

        let key_ty = M.key_ty

        let boxed = (m, snd M.boxed)
      end in
      return
        ( ctxt,
          (module M : Boxed_map with type key = M.key and type value = M.value),
          ids,
          acc )
  | (Option_t (_, _, true), None) ->
      return (ctxt, None, ids, acc)
  | (List_t (_, _, false), v) ->
      return (ctxt, v, ids, acc)
  | (Map_t (_, _, _, false), v) ->
      return (ctxt, v, ids, acc)
  | (Option_t (_, _, false), None) ->
      return (ctxt, None, ids, acc)
  | (Pair_t (_, _, _, false), v) ->
      return (ctxt, v, ids, acc)
  | (Union_t (_, _, _, false), v) ->
      return (ctxt, v, ids, acc)
  | (Option_t (_, _, false), v) ->
      return (ctxt, v, ids, acc)
  | (Chain_id_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Set_t (_, _), v) ->
      return (ctxt, v, ids, acc)
  | (Unit_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Int_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Nat_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Signature_t _, v) ->
      return (ctxt, v, ids, acc)
  | (String_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Bytes_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Mutez_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Key_hash_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Key_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Timestamp_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Address_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Bool_t _, v) ->
      return (ctxt, v, ids, acc)
  | (Lambda_t (_, _, _), v) ->
      return (ctxt, v, ids, acc)
  | (Contract_t (_, _), v) ->
      return (ctxt, v, ids, acc)
  | (Operation_t _, _) ->
      assert false

(* called only on parameters and storage, which cannot contain operations *)

let collect_big_maps ctxt ty x =
  let rec collect :
      type a. context -> a ty -> a -> Ids.t -> (Ids.t * context) tzresult =
   fun ctxt ty x acc ->
    match (ty, x) with
    | (Big_map_t (_, _, _), {id = Some id}) ->
        Gas.consume ctxt Typecheck_costs.cycle
        >>? fun ctxt -> ok (Ids.add id acc, ctxt)
    | (Pair_t ((tyl, _, _), (tyr, _, _), _, true), (xl, xr)) ->
        collect ctxt tyl xl acc >>? fun (acc, ctxt) -> collect ctxt tyr xr acc
    | (Union_t ((ty, _), (_, _), _, true), L x) ->
        collect ctxt ty x acc
    | (Union_t ((_, _), (ty, _), _, true), R x) ->
        collect ctxt ty x acc
    | (Option_t (ty, _, true), Some x) ->
        collect ctxt ty x acc
    | (List_t (ty, _, true), l) ->
        List.fold_left
          (fun acc x -> acc >>? fun (acc, ctxt) -> collect ctxt ty x acc)
          (ok (acc, ctxt))
          l
    | (Map_t (_, ty, _, true), m) ->
        map_fold
          (fun _ v acc -> acc >>? fun (acc, ctxt) -> collect ctxt ty v acc)
          m
          (ok (acc, ctxt))
    | (List_t (_, _, false), _) ->
        ok (acc, ctxt)
    | (Map_t (_, _, _, false), _) ->
        ok (acc, ctxt)
    | (Big_map_t (_, _, _), {id = None}) ->
        ok (acc, ctxt)
    | (Option_t (_, _, true), None) ->
        ok (acc, ctxt)
    | (Option_t (_, _, false), _) ->
        ok (acc, ctxt)
    | (Union_t (_, _, _, false), _) ->
        ok (acc, ctxt)
    | (Pair_t (_, _, _, false), _) ->
        ok (acc, ctxt)
    | (Chain_id_t _, _) ->
        ok (acc, ctxt)
    | (Set_t (_, _), _) ->
        ok (acc, ctxt)
    | (Unit_t _, _) ->
        ok (acc, ctxt)
    | (Int_t _, _) ->
        ok (acc, ctxt)
    | (Nat_t _, _) ->
        ok (acc, ctxt)
    | (Signature_t _, _) ->
        ok (acc, ctxt)
    | (String_t _, _) ->
        ok (acc, ctxt)
    | (Bytes_t _, _) ->
        ok (acc, ctxt)
    | (Mutez_t _, _) ->
        ok (acc, ctxt)
    | (Key_hash_t _, _) ->
        ok (acc, ctxt)
    | (Key_t _, _) ->
        ok (acc, ctxt)
    | (Timestamp_t _, _) ->
        ok (acc, ctxt)
    | (Address_t _, _) ->
        ok (acc, ctxt)
    | (Bool_t _, _) ->
        ok (acc, ctxt)
    | (Lambda_t (_, _, _), _) ->
        ok (acc, ctxt)
    | (Contract_t (_, _), _) ->
        ok (acc, ctxt)
    | (Operation_t _, _) ->
        assert false
   (* called only on parameters and storage, which cannot contain operations *)
  in
  Lwt.return (collect ctxt ty x no_big_map_id)

let extract_big_map_diff ctxt mode ~temporary ~to_duplicate ~to_update ty v =
  let to_duplicate = Ids.diff to_duplicate to_update in
  let fresh =
    if temporary then fun c -> return (Big_map.fresh_temporary c)
    else Big_map.fresh
  in
  extract_big_map_updates ctxt fresh mode to_duplicate [] ty v
  >>=? fun (ctxt, v, alive, diffs) ->
  let diffs =
    if temporary then diffs
    else
      let dead = Ids.diff to_update alive in
      Ids.fold (fun id acc -> Contract.Clear id :: acc) dead [] :: diffs
  in
  match diffs with
  | [] ->
      return (v, None, ctxt)
  | diffs ->
      return (v, Some (List.flatten diffs (* do not reverse *)), ctxt)

let list_of_big_map_ids ids = Ids.elements ids
script_ir_translator_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Import Micheline.

Import Script.

Import Script_typed_ir.

Import Script_tc_errors.

Import Script_ir_annot.

Module Typecheck_costs := Michelson_v1_gas.Cost_of.Typechecking.

Module Unparse_costs := Michelson_v1_gas.Cost_of.Unparse.

Reserved Notation "'ex_comparable_ty".

Inductive ex_comparable_ty_gadt : Type :=
| Ex_comparable_ty : forall {a : Type},
  Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a ->
  ex_comparable_ty_gadt

where "'ex_comparable_ty" := (ex_comparable_ty_gadt).

Definition ex_comparable_ty := 'ex_comparable_ty.

Reserved Notation "'ex_ty".

Inductive ex_ty_gadt : Type :=
| Ex_ty : forall {a : Type}, Tezos_raw_protocol_alpha.Script_typed_ir.ty a ->
  ex_ty_gadt

where "'ex_ty" := (ex_ty_gadt).

Definition ex_ty := 'ex_ty.

Reserved Notation "'ex_stack_ty".

Inductive ex_stack_ty_gadt : Type :=
| Ex_stack_ty : forall {a : Type},
  Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty a -> ex_stack_ty_gadt

where "'ex_stack_ty" := (ex_stack_ty_gadt).

Definition ex_stack_ty := 'ex_stack_ty.

Reserved Notation "'tc_context".

Inductive tc_context_gadt : Type :=
| Lambda : tc_context_gadt
| Dip : forall {a : Type}, Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty a
  -> tc_context_gadt -> tc_context_gadt
| Toplevel : forall {param sto : Type},
  Tezos_raw_protocol_alpha.Script_typed_ir.ty sto ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty param -> option string -> bool ->
  tc_context_gadt

where "'tc_context" := (tc_context_gadt).

Definition tc_context := 'tc_context.

Inductive unparsing_mode : Type :=
| Optimized : unparsing_mode
| Readable : unparsing_mode.

Definition type_logger :=
  Z ->
    list
      (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
        Tezos_raw_protocol_alpha.Alpha_context.Script.annot) ->
      list
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.annot) -> unit.

Definition add_dip {A : Type}
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.ty A)
  (annot : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  (prev : tc_context) : tc_context :=
  match prev with
  | Lambda | Toplevel _ =>
    Dip
      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ty
        Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t annot) prev
  | Dip stack _ =>
    Dip (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ty stack annot) prev
  end.

Fixpoint comparable_type_size {a t : Type}
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_struct t a) : Z :=
  match ty with
  | Tezos_raw_protocol_alpha.Script_typed_ir.Int_key _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.String_key _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Address_key _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key _ (t, _) _ =>
    op_plus 1 (comparable_type_size t)
  end.

Fixpoint type_size {t : Type}
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.ty t) : Z :=
  match ty with
  | Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.String_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (l, _, _) (r, _, _) _ _ =>
    op_plus (op_plus 1 (type_size l)) (type_size r)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (l, _) (r, _) _ _ =>
    op_plus (op_plus 1 (type_size l)) (type_size r)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t arg ret _ =>
    op_plus (op_plus 1 (type_size arg)) (type_size ret)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Option_t t _ _ =>
    op_plus 1 (type_size t)
  | Tezos_raw_protocol_alpha.Script_typed_ir.List_t t _ _ =>
    op_plus 1 (type_size t)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Set_t k _ =>
    op_plus 1 (comparable_type_size k)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Map_t k v _ _ =>
    op_plus (op_plus 1 (comparable_type_size k)) (type_size v)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t k v _ =>
    op_plus (op_plus 1 (comparable_type_size k)) (type_size v)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t arg _ =>
    op_plus 1 (type_size arg)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _ => 1
  end.

Fixpoint type_size_of_stack_head {st : Type}
  (stack : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty st) (up_to : Z)
  : Z :=
  match stack with
  | Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Item_t head tail _annot =>
    if
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
        up_to 0 then
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.max)
        (type_size head) (type_size_of_stack_head tail (op_minus up_to 1))
    else
      0
  end.

Definition number_of_generated_growing_types {a b : Type}
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.instr b a)
  : Z :=
  match function_parameter with
  | Tezos_raw_protocol_alpha.Script_typed_ir.Drop => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Dup => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Swap => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Const _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Cons_pair => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Car => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Cdr => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Cons_some => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Cons_none _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.If_none _ _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Left => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Right => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.If_left _ _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Cons_list => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Nil => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.If_cons _ _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.List_map _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.List_size => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.List_iter _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Empty_set _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Set_iter _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Set_mem => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Set_update => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Set_size => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Empty_map _ _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Map_map _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Map_iter _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Map_mem => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Map_get => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Map_update => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Map_size => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Empty_big_map _ _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_get => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_update => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_mem => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Concat_string => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Concat_string_pair => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Slice_string => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.String_size => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Concat_bytes => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Concat_bytes_pair => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Slice_bytes => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_size => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Add_seconds_to_timestamp => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Add_timestamp_to_seconds => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Sub_timestamp_seconds => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Diff_timestamps => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Add_tez => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Sub_tez => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_teznat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_nattez => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_teznat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_tez => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Or => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.And => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Xor => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Not => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Is_nat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Neg_nat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Neg_int => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Abs_int => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Int_nat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Add_intint => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Add_intnat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Add_natint => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Add_natnat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Sub_int => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_intint => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_intnat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_natint => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mul_natnat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_intint => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_intnat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_natint => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_natnat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Lsl_nat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Lsr_nat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Or_nat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.And_nat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.And_int_nat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Xor_nat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Not_nat => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Not_int => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Seq _ _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.If _ _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Loop _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Loop_left _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Dip _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Exec => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Apply _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Lambda _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Failwith _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Nop => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Compare _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Eq => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Neq => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Lt => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Gt => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Le => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Ge => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Address => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Contract _ _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Transfer_tokens => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Create_account => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Implicit_account => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Create_contract _ _ _ _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Create_contract_2 _ _ _ _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Now => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Balance => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Check_signature => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Hash_key => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Blake2b => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Sha256 => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Sha512 => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Steps_to_quota => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Source => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Sender => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Self _ _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Amount => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Set_delegate => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Pack _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Unpack _ => 1
  | Tezos_raw_protocol_alpha.Script_typed_ir.Dig _ _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Dug _ _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Dipn _ _ _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.Dropn _ _ => 0
  | Tezos_raw_protocol_alpha.Script_typed_ir.ChainId => 0
  end.

Definition location {A B : Type}
  (function_parameter :
    Tezos_protocol_environment_alpha__Environment.Micheline.node A B) : A :=
  let
    'Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc _ _ _ |
      Tezos_protocol_environment_alpha__Environment.Micheline.Int loc _ |
      Tezos_protocol_environment_alpha__Environment.Micheline.String loc _ |
      Tezos_protocol_environment_alpha__Environment.Micheline.Bytes loc _ |
      Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc _ :=
    function_parameter in
  loc.

Definition kind {A B : Type}
  (function_parameter :
    Tezos_protocol_environment_alpha__Environment.Micheline.node A B)
  : Tezos_raw_protocol_alpha.Script_tc_errors.kind :=
  match function_parameter with
  | Tezos_protocol_environment_alpha__Environment.Micheline.Int _ _ =>
    Tezos_raw_protocol_alpha.Script_tc_errors.Int_kind
  | Tezos_protocol_environment_alpha__Environment.Micheline.String _ _ =>
    Tezos_raw_protocol_alpha.Script_tc_errors.String_kind
  | Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ _ =>
    Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind
  | Tezos_protocol_environment_alpha__Environment.Micheline.Prim _ _ _ _ =>
    Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind
  | Tezos_protocol_environment_alpha__Environment.Micheline.Seq _ _ =>
    Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind
  end.

Definition namespace
  (function_parameter : Tezos_raw_protocol_alpha.Alpha_context.Script.prim)
  : Tezos_raw_protocol_alpha.Script_tc_errors.namespace :=
  match function_parameter with
  |
    Tezos_raw_protocol_alpha.Alpha_context.Script.K_parameter |
      Tezos_raw_protocol_alpha.Alpha_context.Script.K_storage |
      Tezos_raw_protocol_alpha.Alpha_context.Script.K_code =>
    Tezos_raw_protocol_alpha.Script_tc_errors.Keyword_namespace
  |
    Tezos_raw_protocol_alpha.Alpha_context.Script.D_False |
      Tezos_raw_protocol_alpha.Alpha_context.Script.D_Elt |
      Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left |
      Tezos_raw_protocol_alpha.Alpha_context.Script.D_None |
      Tezos_raw_protocol_alpha.Alpha_context.Script.D_Pair |
      Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right |
      Tezos_raw_protocol_alpha.Alpha_context.Script.D_Some |
      Tezos_raw_protocol_alpha.Alpha_context.Script.D_True |
      Tezos_raw_protocol_alpha.Alpha_context.Script.D_Unit =>
    Tezos_raw_protocol_alpha.Script_tc_errors.Constant_namespace
  |
    Tezos_raw_protocol_alpha.Alpha_context.Script.I_PACK |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_UNPACK |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_BLAKE2B |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SHA256 |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SHA512 |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_ABS |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_AMOUNT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_AND |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_BALANCE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_CAR |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_CDR |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_CHAIN_ID |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_CHECK_SIGNATURE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_COMPARE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONCAT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONS |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_ACCOUNT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_CONTRACT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_IMPLICIT_ACCOUNT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIP |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_DROP |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUP |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_EMPTY_BIG_MAP |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_EMPTY_MAP |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_EMPTY_SET |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_EQ |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_EXEC |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_APPLY |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_FAILWITH |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_GE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_GET |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_GT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_HASH_KEY |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_CONS |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_LEFT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_NONE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_INT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_LAMBDA |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_LE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_LEFT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_LOOP |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSL |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSR |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_LT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_MAP |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_MEM |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEG |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEQ |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_NIL |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_NONE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOW |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_OR |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_PAIR |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_PUSH |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_RIGHT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SIZE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SOME |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SOURCE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SENDER |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SELF |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SLICE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_STEPS_TO_QUOTA |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SWAP |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_TRANSFER_TOKENS |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SET_DELEGATE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_UNIT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_XOR |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_ITER |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_LOOP_LEFT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADDRESS |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONTRACT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_ISNAT |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_CAST |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_RENAME |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIG |
      Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUG =>
    Tezos_raw_protocol_alpha.Script_tc_errors.Instr_namespace
  |
    Tezos_raw_protocol_alpha.Alpha_context.Script.T_bool |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_contract |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_int |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_key |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_key_hash |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_lambda |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_list |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_map |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_big_map |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_nat |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_option |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_or |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_pair |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_set |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_signature |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_string |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_bytes |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_mutez |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_timestamp |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_unit |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_operation |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_address |
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_chain_id =>
    Tezos_raw_protocol_alpha.Script_tc_errors.Type_namespace
  end.

Definition unexpected
  (expr :
    Tezos_protocol_environment_alpha__Environment.Micheline.node
      Tezos_raw_protocol_alpha.Alpha_context.Script.location
      Tezos_raw_protocol_alpha.Alpha_context.Script.prim)
  (exp_kinds : list Tezos_raw_protocol_alpha.Script_tc_errors.kind)
  (exp_ns : Tezos_raw_protocol_alpha.Script_tc_errors.namespace)
  (exp_prims : list Tezos_raw_protocol_alpha.Alpha_context.Script.prim)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.error :=
  match expr with
  | Tezos_protocol_environment_alpha__Environment.Micheline.Int loc _ =>
    Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind loc
      (cons Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind exp_kinds)
      Tezos_raw_protocol_alpha.Script_tc_errors.Int_kind
  | Tezos_protocol_environment_alpha__Environment.Micheline.String loc _ =>
    Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind loc
      (cons Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind exp_kinds)
      Tezos_raw_protocol_alpha.Script_tc_errors.String_kind
  | Tezos_protocol_environment_alpha__Environment.Micheline.Bytes loc _ =>
    Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind loc
      (cons Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind exp_kinds)
      Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind
  | Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc _ =>
    Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind loc
      (cons Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind exp_kinds)
      Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind
  | Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc name _ _ =>
    match ((namespace name), exp_ns) with
    |
      (Tezos_raw_protocol_alpha.Script_tc_errors.Type_namespace,
        Tezos_raw_protocol_alpha.Script_tc_errors.Type_namespace) |
        (Tezos_raw_protocol_alpha.Script_tc_errors.Instr_namespace,
          Tezos_raw_protocol_alpha.Script_tc_errors.Instr_namespace) |
        (Tezos_raw_protocol_alpha.Script_tc_errors.Constant_namespace,
          Tezos_raw_protocol_alpha.Script_tc_errors.Constant_namespace) =>
      Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_primitive
        loc exp_prims name
    | (ns, _) =>
      Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_namespace
        loc name exp_ns ns
    end
  end.

Definition check_kind {A : Type}
  (kinds : list Tezos_raw_protocol_alpha.Script_tc_errors.kind)
  (expr :
    Tezos_protocol_environment_alpha__Environment.Micheline.node
      Tezos_raw_protocol_alpha.Alpha_context.Script.location A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let kind := kind expr in
  if List.mem kind kinds then
    return_unit
  else
    let loc := location expr in
    fail
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
        loc kinds kind).

Definition wrap_compare {A B : Type}
  (compare :
    A ->
      B ->
        Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  (a : A) (b : B) : Z :=
  let res := compare a b in
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
      res 0 then
    0
  else
    if
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
        res 0 then
      1
    else
      (-1).

Fixpoint compare_comparable {a s : Type}
  (kind : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_struct a s)
  : a -> a -> Z :=
  match kind with
  | Tezos_raw_protocol_alpha.Script_typed_ir.String_key _ =>
    wrap_compare
      Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.compare)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key _ =>
    wrap_compare
      Tezos_protocol_environment_alpha__Environment.Compare.Bool.(Tezos_protocol_environment_alpha__Environment.S.Compare.compare)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key _ =>
    wrap_compare Tez.compare
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key _ =>
    wrap_compare Signature.Public_key_hash.compare
  | Tezos_raw_protocol_alpha.Script_typed_ir.Int_key _ =>
    wrap_compare Script_int.compare
  | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key _ =>
    wrap_compare Script_int.compare
  | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key _ =>
    wrap_compare Script_timestamp.compare
  | Tezos_raw_protocol_alpha.Script_typed_ir.Address_key _ =>
    op_atat wrap_compare
      (fun function_parameter =>
        let '(x, ex) := function_parameter in
        fun function_parameter =>
          let '(y, ey) := function_parameter in
          let lres := Contract.compare x y in
          if
            Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
              lres 0 then
            Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.compare)
              ex ey
          else
            lres)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key _ =>
    wrap_compare MBytes.compare
  | Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key (tl, _) (tr, _) _ =>
    fun function_parameter =>
      let '(lx, rx) := function_parameter in
      fun function_parameter =>
        let '(ly, ry) := function_parameter in
        let lres := compare_comparable tl lx ly in
        if
          Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
            lres 0 then
          compare_comparable tr rx ry
        else
          lres
  end.

Definition empty_set {a : Type}
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a)
  : Tezos_raw_protocol_alpha.Script_typed_ir.set a :=
  let OPS :=
    (* ❌ Applications of functors are not supported for first-class module values *)
    unsupported_functor_application in
  existT _ _
    {|
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.elt_ty := ty;
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.OPS := OPS;
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.boxed := OPS.empty;
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.size := 0
      |}.

Definition set_update {a : Type}
  (v : a) (b : bool) (Box : Tezos_raw_protocol_alpha.Script_typed_ir.set a)
  : Tezos_raw_protocol_alpha.Script_typed_ir.set a :=
  let Box := projT2 Box in
  existT _ _
    {|
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.elt_ty :=
        Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.elt_ty);
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.OPS :=
        Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.OPS);
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.boxed :=
        if b then
          Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.OPS).(Tezos_protocol_environment_alpha__Environment.SET.S.add)
            v Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.boxed)
        else
          Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.OPS).(Tezos_protocol_environment_alpha__Environment.SET.S.remove)
            v Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.boxed);
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.size :=
        let mem :=
          Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.OPS).(Tezos_protocol_environment_alpha__Environment.SET.S.mem)
            v Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.boxed) in
        if mem then
          if b then
            Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.size)
          else
            op_minus
              Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.size) 1
        else
          if b then
            op_plus
              Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.size) 1
          else
            Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.size)
      |}.

Definition set_mem {elt : Type}
  (v : elt) (Box : Tezos_raw_protocol_alpha.Script_typed_ir.set elt) : bool :=
  let Box := projT2 Box in
  Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.OPS).(Tezos_protocol_environment_alpha__Environment.SET.S.mem)
    v Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.boxed).

Definition set_fold {acc elt : Type}
  (f : elt -> acc -> acc)
  (Box : Tezos_raw_protocol_alpha.Script_typed_ir.set elt) : acc -> acc :=
  let Box := projT2 Box in
  Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.OPS).(Tezos_protocol_environment_alpha__Environment.SET.S.fold)
    f Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.boxed).

Definition set_size {elt : Type}
  (Box : Tezos_raw_protocol_alpha.Script_typed_ir.set elt)
  : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
    Tezos_raw_protocol_alpha.Alpha_context.Script_int.n :=
  let Box := projT2 Box in
  abs (of_int Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_set.size)).

Definition map_key_ty {a b : Type}
  (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map a b)
  : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a :=
  let Box := projT2 Box in
  Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.key_ty).

Definition empty_map {a b : Type}
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a)
  : Tezos_raw_protocol_alpha.Script_typed_ir.map a b :=
  let OPS :=
    (* ❌ Applications of functors are not supported for first-class module values *)
    unsupported_functor_application in
  existT _ _
    {|
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.key_ty := ty;
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS := OPS;
      (* ❌ This kind of definition of value for first-class modules is not handled *)
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed := unhandled
      |}.

Definition map_get {key value : Type}
  (k : key) (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map key value)
  : option value :=
  let Box := projT2 Box in
  Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.find_opt)
    k (fst Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed)).

Definition map_update {a b : Type}
  (k : a) (v : option b)
  (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map a b)
  : Tezos_raw_protocol_alpha.Script_typed_ir.map a b :=
  let Box := projT2 Box in
  existT _ _
    {|
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.key_ty :=
        Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.key_ty);
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS :=
        Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS);
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed :=
        let '(map, size) :=
          Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed) in
        let contains :=
          Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.mem)
            k map in
        match v with
        | Some v =>
          ((Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.add)
            k v map),
            (op_plus size
              (if contains then
                0
              else
                1)))
        | None =>
          ((Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.remove)
            k map),
            (op_minus size
              (if contains then
                1
              else
                0)))
        end
      |}.

Definition map_set {a b : Type}
  (k : a) (v : b) (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map a b)
  : Tezos_raw_protocol_alpha.Script_typed_ir.map a b :=
  let Box := projT2 Box in
  existT _ _
    {|
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.key_ty :=
        Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.key_ty);
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS :=
        Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS);
      Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed :=
        let '(map, size) :=
          Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed) in
        ((Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.add)
          k v map),
          (if
            Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.mem)
              k map then
            size
          else
            op_plus size 1))
      |}.

Definition map_mem {key value : Type}
  (k : key) (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map key value)
  : bool :=
  let Box := projT2 Box in
  Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.mem)
    k (fst Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed)).

Definition map_fold {acc key value : Type}
  (f : key -> value -> acc -> acc)
  (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map key value) : acc -> acc :=
  let Box := projT2 Box in
  Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.fold)
    f (fst Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed)).

Definition map_size {key value : Type}
  (Box : Tezos_raw_protocol_alpha.Script_typed_ir.map key value)
  : Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
    Tezos_raw_protocol_alpha.Alpha_context.Script_int.n :=
  let Box := projT2 Box in
  abs
    (of_int (snd Box.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed))).

Fixpoint ty_of_comparable_ty {a s : Type}
  (function_parameter :
    Tezos_raw_protocol_alpha.Script_typed_ir.comparable_struct a s)
  : Tezos_raw_protocol_alpha.Script_typed_ir.ty a :=
  match function_parameter with
  | Tezos_raw_protocol_alpha.Script_typed_ir.Int_key tname =>
    Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key tname =>
    Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.String_key tname =>
    Tezos_raw_protocol_alpha.Script_typed_ir.String_t tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key tname =>
    Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key tname =>
    Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key tname =>
    Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key tname =>
    Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key tname =>
    Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Address_key tname =>
    Tezos_raw_protocol_alpha.Script_typed_ir.Address_t tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key (l, al) (r, ar) tname =>
    Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
      ((ty_of_comparable_ty l), al, None) ((ty_of_comparable_ty r), ar, None)
      tname false
  end.

Fixpoint comparable_ty_of_ty {a : Type}
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.ty a)
  : option (Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a) :=
  match function_parameter with
  | Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname =>
    Some (Tezos_raw_protocol_alpha.Script_typed_ir.Int_key tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname =>
    Some (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.String_t tname =>
    Some (Tezos_raw_protocol_alpha.Script_typed_ir.String_key tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tname =>
    Some (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname =>
    Some (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname =>
    Some (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t tname =>
    Some (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname =>
    Some (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Address_t tname =>
    Some (Tezos_raw_protocol_alpha.Script_typed_ir.Address_key tname)
  |
    Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (l, al, _) (r, ar, _) pname
      _ =>
    match comparable_ty_of_ty r with
    | None => None
    | Some rty =>
      match comparable_ty_of_ty l with
      | None => None
      | Some (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key _ _ _) => None
      | Some (Tezos_raw_protocol_alpha.Script_typed_ir.Int_key tname) =>
        Some
          (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key
            ((Tezos_raw_protocol_alpha.Script_typed_ir.Int_key tname), al)
            (rty, ar) pname)
      | Some (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key tname) =>
        Some
          (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key
            ((Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key tname), al)
            (rty, ar) pname)
      | Some (Tezos_raw_protocol_alpha.Script_typed_ir.String_key tname) =>
        Some
          (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key
            ((Tezos_raw_protocol_alpha.Script_typed_ir.String_key tname), al)
            (rty, ar) pname)
      | Some (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key tname) =>
        Some
          (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key
            ((Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key tname), al)
            (rty, ar) pname)
      | Some (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key tname) =>
        Some
          (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key
            ((Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key tname), al)
            (rty, ar) pname)
      | Some (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key tname) =>
        Some
          (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key
            ((Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key tname), al)
            (rty, ar) pname)
      | Some (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key tname) =>
        Some
          (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key
            ((Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key tname), al)
            (rty, ar) pname)
      | Some (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key tname) =>
        Some
          (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key
            ((Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key tname), al)
            (rty, ar) pname)
      | Some (Tezos_raw_protocol_alpha.Script_typed_ir.Address_key tname) =>
        Some
          (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key
            ((Tezos_raw_protocol_alpha.Script_typed_ir.Address_key tname), al)
            (rty, ar) pname)
      end
    end
  | _ => None
  end.

Definition add_field_annot {A B : Type}
  (a : option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  (var : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  (function_parameter :
    Tezos_protocol_environment_alpha__Environment.Micheline.node A B)
  : Tezos_protocol_environment_alpha__Environment.Micheline.node A B :=
  match function_parameter with
  |
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc prim args
      annots =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc prim args
      (op_at annots (op_at (unparse_field_annot a) (unparse_var_annot var)))
  | expr => expr
  end.

Fixpoint unparse_comparable_ty {a s : Type}
  (function_parameter :
    Tezos_raw_protocol_alpha.Script_typed_ir.comparable_struct a s)
  : Tezos_raw_protocol_alpha.Alpha_context.Script.node :=
  match function_parameter with
  | Tezos_raw_protocol_alpha.Script_typed_ir.Int_key tname =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1)
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_int []
      (unparse_type_annot tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key tname =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1)
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_nat []
      (unparse_type_annot tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.String_key tname =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1)
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_string []
      (unparse_type_annot tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key tname =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1)
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_bytes []
      (unparse_type_annot tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key tname =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1)
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_mutez []
      (unparse_type_annot tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key tname =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1)
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_bool []
      (unparse_type_annot tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key tname =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1)
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_key_hash []
      (unparse_type_annot tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key tname =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1)
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_timestamp []
      (unparse_type_annot tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Address_key tname =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1)
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_address []
      (unparse_type_annot tname)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Pair_key (l, al) (r, ar) pname =>
    let tl := add_field_annot al None (unparse_comparable_ty l) in
    let tr := add_field_annot ar None (unparse_comparable_ty r) in
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1)
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_pair
      (cons tl (cons tr [])) (unparse_type_annot pname)
  end.

Fixpoint unparse_ty_no_lwt {a : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.ty a)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_raw_protocol_alpha.Alpha_context.Script.node *
      Tezos_raw_protocol_alpha.Alpha_context.context) :=
  op_gtgtquestion (Gas.consume ctxt Unparse_costs.cycle)
    (fun ctxt =>
      let __return {B : Type}
        (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
        (function_parameter :
        B *
          list
            (Tezos_protocol_environment_alpha__Environment.Micheline.node Z B) *
          Tezos_protocol_environment_alpha__Environment.Micheline.annot)
        : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_protocol_environment_alpha__Environment.Micheline.node Z B *
            Tezos_raw_protocol_alpha__Alpha_context.context) :=
        let '(name, args, annot) := function_parameter in
        let result :=
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim (-1) name
            args annot in
        op_gtgtquestion
          (Gas.consume ctxt (Unparse_costs.prim_cost (List.length args) annot))
          (fun ctxt => ok (result, ctxt)) in
      match ty with
      | Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_unit, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_int, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_nat, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.String_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_string, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_bytes, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_mutez, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_bool, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_key_hash, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Key_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_key, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_timestamp, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Address_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_address, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_signature, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_operation, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t tname =>
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_chain_id, [],
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t ut tname =>
        op_gtgtquestion (unparse_ty_no_lwt ctxt ut)
          (fun function_parameter =>
            let '(t, ctxt) := function_parameter in
            __return ctxt
              (Tezos_raw_protocol_alpha.Alpha_context.Script.T_contract,
                (cons t []), (unparse_type_annot tname)))
      |
        Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (utl, l_field, l_var)
          (utr, r_field, r_var) tname _ =>
        let annot := unparse_type_annot tname in
        op_gtgtquestion (unparse_ty_no_lwt ctxt utl)
          (fun function_parameter =>
            let '(utl, ctxt) := function_parameter in
            let tl := add_field_annot l_field l_var utl in
            op_gtgtquestion (unparse_ty_no_lwt ctxt utr)
              (fun function_parameter =>
                let '(utr, ctxt) := function_parameter in
                let tr := add_field_annot r_field r_var utr in
                __return ctxt
                  (Tezos_raw_protocol_alpha.Alpha_context.Script.T_pair,
                    (cons tl (cons tr [])), annot)))
      |
        Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (utl, l_field)
          (utr, r_field) tname _ =>
        let annot := unparse_type_annot tname in
        op_gtgtquestion (unparse_ty_no_lwt ctxt utl)
          (fun function_parameter =>
            let '(utl, ctxt) := function_parameter in
            let tl := add_field_annot l_field None utl in
            op_gtgtquestion (unparse_ty_no_lwt ctxt utr)
              (fun function_parameter =>
                let '(utr, ctxt) := function_parameter in
                let tr := add_field_annot r_field None utr in
                __return ctxt
                  (Tezos_raw_protocol_alpha.Alpha_context.Script.T_or,
                    (cons tl (cons tr [])), annot)))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t uta utr tname =>
        op_gtgtquestion (unparse_ty_no_lwt ctxt uta)
          (fun function_parameter =>
            let '(ta, ctxt) := function_parameter in
            op_gtgtquestion (unparse_ty_no_lwt ctxt utr)
              (fun function_parameter =>
                let '(tr, ctxt) := function_parameter in
                __return ctxt
                  (Tezos_raw_protocol_alpha.Alpha_context.Script.T_lambda,
                    (cons ta (cons tr [])), (unparse_type_annot tname))))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Option_t ut tname _ =>
        let annot := unparse_type_annot tname in
        op_gtgtquestion (unparse_ty_no_lwt ctxt ut)
          (fun function_parameter =>
            let '(ut, ctxt) := function_parameter in
            __return ctxt
              (Tezos_raw_protocol_alpha.Alpha_context.Script.T_option,
                (cons ut []), annot))
      | Tezos_raw_protocol_alpha.Script_typed_ir.List_t ut tname _ =>
        op_gtgtquestion (unparse_ty_no_lwt ctxt ut)
          (fun function_parameter =>
            let '(t, ctxt) := function_parameter in
            __return ctxt
              (Tezos_raw_protocol_alpha.Alpha_context.Script.T_list,
                (cons t []), (unparse_type_annot tname)))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Set_t ut tname =>
        let t := unparse_comparable_ty ut in
        __return ctxt
          (Tezos_raw_protocol_alpha.Alpha_context.Script.T_set, (cons t []),
            (unparse_type_annot tname))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Map_t uta utr tname _ =>
        let ta := unparse_comparable_ty uta in
        op_gtgtquestion (unparse_ty_no_lwt ctxt utr)
          (fun function_parameter =>
            let '(tr, ctxt) := function_parameter in
            __return ctxt
              (Tezos_raw_protocol_alpha.Alpha_context.Script.T_map,
                (cons ta (cons tr [])), (unparse_type_annot tname)))
      | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t uta utr tname =>
        let ta := unparse_comparable_ty uta in
        op_gtgtquestion (unparse_ty_no_lwt ctxt utr)
          (fun function_parameter =>
            let '(tr, ctxt) := function_parameter in
            __return ctxt
              (Tezos_raw_protocol_alpha.Alpha_context.Script.T_big_map,
                (cons ta (cons tr [])), (unparse_type_annot tname)))
      end).

Definition unparse_ty {A : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.ty A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.Script.node *
        Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  Lwt.__return (unparse_ty_no_lwt ctxt ty).

Fixpoint strip_var_annots {A B : Type}
  (function_parameter :
    Tezos_protocol_environment_alpha__Environment.Micheline.node A B)
  : Tezos_protocol_environment_alpha__Environment.Micheline.node A B :=
  match function_parameter with
  |
    (Tezos_protocol_environment_alpha__Environment.Micheline.Int _ _ |
      Tezos_protocol_environment_alpha__Environment.Micheline.String _ _ |
      Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ _) as atom
    => atom
  | Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc args =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc
      (List.map strip_var_annots args)
  |
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc name args
      annots =>
    let not_var_annot (s : string) : bool :=
      Tezos_protocol_environment_alpha__Environment.Compare.Char.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_ltgt)
        (String.get s 0) "@" % char in
    let annots := List.filter not_var_annot annots in
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc name
      (List.map strip_var_annots args) annots
  end.

Definition serialize_ty_for_error {A : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.ty A)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_protocol_environment_alpha__Environment.Micheline.canonical
      Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
      Tezos_raw_protocol_alpha.Alpha_context.context) :=
  op_gtpipequestion
    (op_pipegt (unparse_ty_no_lwt ctxt ty)
      (record_trace
        Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_error))
    (fun function_parameter =>
      let '(ty, ctxt) := function_parameter in
      ((strip_locations (strip_var_annots ty)), ctxt)).

Fixpoint unparse_stack {a : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty a)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.annot) *
        Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  match function_parameter with
  | Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t => __return ([], ctxt)
  | Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ty rest annot =>
    op_gtgteqquestion (unparse_ty ctxt ty)
      (fun function_parameter =>
        let '(uty, ctxt) := function_parameter in
        op_gtgteqquestion (unparse_stack ctxt rest)
          (fun function_parameter =>
            let '(urest, ctxt) := function_parameter in
            __return
              ((cons ((strip_locations uty), (unparse_var_annot annot)) urest),
                ctxt)))
  end.

Definition serialize_stack_for_error {A : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (stack_ty : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.annot) *
        Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  trace
    Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_error
    (unparse_stack ctxt stack_ty).

Definition name_of_ty {a : Type}
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.ty a)
  : option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot :=
  match function_parameter with
  | Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.String_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Address_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t _ tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t _ _ tname _ => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ _ tname _ => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t _ _ tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ tname _ => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.List_t _ tname _ => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Set_t _ tname => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Map_t _ _ tname _ => tname
  | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t _ _ tname => tname
  end.

Reserved Notation "'eq".

Inductive eq_gadt : Type :=
| Eq : eq_gadt

where "'eq" := (fun (ta tb : Type) => eq_gadt).

Definition eq := 'eq.

Definition comparable_ty_eq {ta tb : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (ta : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty ta)
  (tb : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty tb)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (eq (Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty ta)
      (Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty tb)) :=
  match (ta, tb) with
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Int_key _,
      Tezos_raw_protocol_alpha.Script_typed_ir.Int_key _) =>
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok Eq
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key _,
      Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key _) =>
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok Eq
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.String_key _,
      Tezos_raw_protocol_alpha.Script_typed_ir.String_key _) =>
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok Eq
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key _,
      Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key _) =>
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok Eq
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key _,
      Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key _) =>
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok Eq
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key _,
      Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key _) =>
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok Eq
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key _,
      Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key _) =>
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok Eq
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key _,
      Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key _) =>
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok Eq
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Address_key _,
      Tezos_raw_protocol_alpha.Script_typed_ir.Address_key _) =>
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok Eq
  | (_, _) =>
    op_gtgtquestion (serialize_ty_for_error ctxt (ty_of_comparable_ty ta))
      (fun function_parameter =>
        let '(ta, ctxt) := function_parameter in
        op_gtgtquestion (serialize_ty_for_error ctxt (ty_of_comparable_ty tb))
          (fun function_parameter =>
            let '(tb, _ctxt) := function_parameter in
            error
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_types
                ta tb)))
  end.

Definition record_inconsistent {A B C : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (ta : Tezos_raw_protocol_alpha.Script_typed_ir.ty A)
  (tb : Tezos_raw_protocol_alpha.Script_typed_ir.ty B)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult C ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult C :=
  record_trace_eval
    (fun function_parameter =>
      let 'tt := function_parameter in
      op_gtgtquestion (serialize_ty_for_error ctxt ta)
        (fun function_parameter =>
          let '(ta, ctxt) := function_parameter in
          op_gtpipequestion (serialize_ty_for_error ctxt tb)
            (fun function_parameter =>
              let '(tb, _ctxt) := function_parameter in
              Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_types
                ta tb))).

Definition record_inconsistent_type_annotations {A B C : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (ta : Tezos_raw_protocol_alpha.Script_typed_ir.ty A)
  (tb : Tezos_raw_protocol_alpha.Script_typed_ir.ty B)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult C ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult C :=
  record_trace_eval
    (fun function_parameter =>
      let 'tt := function_parameter in
      op_gtgtquestion (serialize_ty_for_error ctxt ta)
        (fun function_parameter =>
          let '(ta, ctxt) := function_parameter in
          op_gtpipequestion (serialize_ty_for_error ctxt tb)
            (fun function_parameter =>
              let '(tb, _ctxt) := function_parameter in
              Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_type_annotations
                loc ta tb))).

Fixpoint ty_eq {ta tb : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (ta : Tezos_raw_protocol_alpha.Script_typed_ir.ty ta)
  (tb : Tezos_raw_protocol_alpha.Script_typed_ir.ty tb)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (eq (Tezos_raw_protocol_alpha.Script_typed_ir.ty ta)
      (Tezos_raw_protocol_alpha.Script_typed_ir.ty tb) *
      Tezos_raw_protocol_alpha.Alpha_context.context) :=
  let ok
    (eq :
    eq (Tezos_raw_protocol_alpha.Script_typed_ir.ty ta)
      (Tezos_raw_protocol_alpha.Script_typed_ir.ty tb)) (ctxt :
    Tezos_raw_protocol_alpha__Alpha_context.context) (nb_args : Z)
    : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (eq (Tezos_raw_protocol_alpha.Script_typed_ir.ty ta)
        (Tezos_raw_protocol_alpha.Script_typed_ir.ty tb) *
        Tezos_raw_protocol_alpha.Alpha_context.context) :=
    op_gtgtquestion
      (Gas.consume ctxt (Typecheck_costs.type_ (op_star 2 nb_args)))
      (fun ctxt =>
        Tezos_protocol_environment_alpha__Environment.Pervasives.Ok (eq, ctxt))
    in
  op_gtgtquestion (Gas.consume ctxt Typecheck_costs.cycle)
    (fun ctxt =>
      match (ta, tb) with
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.String_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.String_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _) =>
        ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _) =>
        ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _) => ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t _) =>
        ok Eq ctxt 0
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t tal tar _ _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Map_t tbl tbr _ _) =>
        op_pipegt
          (op_gtgtquestion (comparable_ty_eq ctxt tal tbl)
            (fun function_parameter =>
              let 'Eq := function_parameter in
              op_gtgtquestion (ty_eq ctxt tar tbr)
                (fun function_parameter =>
                  let '(Eq, ctxt) := function_parameter in
                  ok Eq ctxt 2))) (record_inconsistent ctxt ta tb)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t tal tar _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t tbl tbr _) =>
        op_pipegt
          (op_gtgtquestion (comparable_ty_eq ctxt tal tbl)
            (fun function_parameter =>
              let 'Eq := function_parameter in
              op_gtgtquestion (ty_eq ctxt tar tbr)
                (fun function_parameter =>
                  let '(Eq, ctxt) := function_parameter in
                  ok Eq ctxt 2))) (record_inconsistent ctxt ta tb)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t ea _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Set_t eb _) =>
        op_pipegt
          (op_gtgtquestion (comparable_ty_eq ctxt ea eb)
            (fun function_parameter =>
              let 'Eq := function_parameter in
              ok Eq ctxt 1)) (record_inconsistent ctxt ta tb)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (tal, _, _) (tar, _, _)
          _ _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (tbl, _, _)
            (tbr, _, _) _ _) =>
        op_pipegt
          (op_gtgtquestion (ty_eq ctxt tal tbl)
            (fun function_parameter =>
              let '(Eq, ctxt) := function_parameter in
              op_gtgtquestion (ty_eq ctxt tar tbr)
                (fun function_parameter =>
                  let '(Eq, ctxt) := function_parameter in
                  ok Eq ctxt 2))) (record_inconsistent ctxt ta tb)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tal, _) (tar, _) _ _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tbl, _) (tbr, _) _ _)
        =>
        op_pipegt
          (op_gtgtquestion (ty_eq ctxt tal tbl)
            (fun function_parameter =>
              let '(Eq, ctxt) := function_parameter in
              op_gtgtquestion (ty_eq ctxt tar tbr)
                (fun function_parameter =>
                  let '(Eq, ctxt) := function_parameter in
                  ok Eq ctxt 2))) (record_inconsistent ctxt ta tb)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t tal tar _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t tbl tbr _) =>
        op_pipegt
          (op_gtgtquestion (ty_eq ctxt tal tbl)
            (fun function_parameter =>
              let '(Eq, ctxt) := function_parameter in
              op_gtgtquestion (ty_eq ctxt tar tbr)
                (fun function_parameter =>
                  let '(Eq, ctxt) := function_parameter in
                  ok Eq ctxt 2))) (record_inconsistent ctxt ta tb)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t tal _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t tbl _) =>
        op_pipegt
          (op_gtgtquestion (ty_eq ctxt tal tbl)
            (fun function_parameter =>
              let '(Eq, ctxt) := function_parameter in
              ok Eq ctxt 1)) (record_inconsistent ctxt ta tb)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t tva _ _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Option_t tvb _ _) =>
        op_pipegt
          (op_gtgtquestion (ty_eq ctxt tva tvb)
            (fun function_parameter =>
              let '(Eq, ctxt) := function_parameter in
              ok Eq ctxt 1)) (record_inconsistent ctxt ta tb)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.List_t tva _ _,
          Tezos_raw_protocol_alpha.Script_typed_ir.List_t tvb _ _) =>
        op_pipegt
          (op_gtgtquestion (ty_eq ctxt tva tvb)
            (fun function_parameter =>
              let '(Eq, ctxt) := function_parameter in
              ok Eq ctxt 1)) (record_inconsistent ctxt ta tb)
      | (_, _) =>
        op_gtgtquestion (serialize_ty_for_error ctxt ta)
          (fun function_parameter =>
            let '(ta, ctxt) := function_parameter in
            op_gtgtquestion (serialize_ty_for_error ctxt tb)
              (fun function_parameter =>
                let '(tb, _ctxt) := function_parameter in
                error
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_types
                    ta tb)))
      end).

Fixpoint stack_ty_eq {ta tb : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (lvl : Z)
  (ta : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty ta)
  (tb : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty tb)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (eq (Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty ta)
      (Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty tb) *
      Tezos_raw_protocol_alpha.Alpha_context.context) :=
  match (ta, tb) with
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t tva ra _,
      Tezos_raw_protocol_alpha.Script_typed_ir.Item_t tvb rb _) =>
    op_gtgtquestion
      (op_pipegt (ty_eq ctxt tva tvb)
        (record_trace
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack_item
            lvl)))
      (fun function_parameter =>
        let '(Eq, ctxt) := function_parameter in
        op_gtgtquestion (stack_ty_eq ctxt (op_plus lvl 1) ra rb)
          (fun function_parameter =>
            let '(Eq, ctxt) := function_parameter in
            Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
              (Eq, ctxt)))
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t,
      Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t) =>
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok (Eq, ctxt)
  | (_, _) =>
    error
      Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack_length
  end.

Definition merge_comparable_types {ta : Type}
  (legacy : bool)
  (ta : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty ta)
  (tb : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty ta)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty ta) :=
  match (ta, tb) with
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Int_key annot_a,
      Tezos_raw_protocol_alpha.Script_typed_ir.Int_key annot_b) =>
    op_gtpipequestion (merge_type_annot legacy annot_a annot_b)
      (fun annot => Tezos_raw_protocol_alpha.Script_typed_ir.Int_key annot)
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key annot_a,
      Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key annot_b) =>
    op_gtpipequestion (merge_type_annot legacy annot_a annot_b)
      (fun annot => Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key annot)
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.String_key annot_a,
      Tezos_raw_protocol_alpha.Script_typed_ir.String_key annot_b) =>
    op_gtpipequestion (merge_type_annot legacy annot_a annot_b)
      (fun annot => Tezos_raw_protocol_alpha.Script_typed_ir.String_key annot)
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key annot_a,
      Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key annot_b) =>
    op_gtpipequestion (merge_type_annot legacy annot_a annot_b)
      (fun annot => Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key annot)
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key annot_a,
      Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key annot_b) =>
    op_gtpipequestion (merge_type_annot legacy annot_a annot_b)
      (fun annot => Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key annot)
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key annot_a,
      Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key annot_b) =>
    op_gtpipequestion (merge_type_annot legacy annot_a annot_b)
      (fun annot => Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key annot)
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key annot_a,
      Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key annot_b) =>
    op_gtpipequestion (merge_type_annot legacy annot_a annot_b)
      (fun annot => Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key annot)
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key annot_a,
      Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key annot_b) =>
    op_gtpipequestion (merge_type_annot legacy annot_a annot_b)
      (fun annot => Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key annot)
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Address_key annot_a,
      Tezos_raw_protocol_alpha.Script_typed_ir.Address_key annot_b) =>
    op_gtpipequestion (merge_type_annot legacy annot_a annot_b)
      (fun annot => Tezos_raw_protocol_alpha.Script_typed_ir.Address_key annot)
  | (_, _) =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  end.

Definition merge_types {b : Type} (legacy : bool)
  : Tezos_raw_protocol_alpha.Alpha_context.context ->
    Tezos_raw_protocol_alpha.Alpha_context.Script.location ->
      Tezos_raw_protocol_alpha.Script_typed_ir.ty b ->
        Tezos_raw_protocol_alpha.Script_typed_ir.ty b ->
          Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (Tezos_raw_protocol_alpha.Script_typed_ir.ty b *
              Tezos_raw_protocol_alpha.Alpha_context.context) :=
  let fix help {a : Type}
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (ty1 :
    Tezos_raw_protocol_alpha.Script_typed_ir.ty a) (ty2 :
    Tezos_raw_protocol_alpha.Script_typed_ir.ty a)
    : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Script_typed_ir.ty a *
        Tezos_raw_protocol_alpha.Alpha_context.context) :=
    match (ty1, ty2) with
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Key_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Key_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.String_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.String_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.String_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Address_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Address_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t tn2) =>
      op_gtpipequestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          ((Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t tname), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t tal tar tn1 has_big_map,
        Tezos_raw_protocol_alpha.Script_typed_ir.Map_t tbl tbr tn2 _) =>
      op_gtgtquestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          op_gtgtquestion (help ctxt tar tbr)
            (fun function_parameter =>
              let '(value, ctxt) := function_parameter in
              op_gtgtquestion (ty_eq ctxt tar value)
                (fun function_parameter =>
                  let '(Eq, ctxt) := function_parameter in
                  op_gtpipequestion (merge_comparable_types legacy tal tbl)
                    (fun tk =>
                      ((Tezos_raw_protocol_alpha.Script_typed_ir.Map_t tk value
                        tname has_big_map), ctxt)))))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t tal tar tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t tbl tbr tn2) =>
      op_gtgtquestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          op_gtgtquestion (help ctxt tar tbr)
            (fun function_parameter =>
              let '(value, ctxt) := function_parameter in
              op_gtgtquestion (ty_eq ctxt tar value)
                (fun function_parameter =>
                  let '(Eq, ctxt) := function_parameter in
                  op_gtpipequestion (merge_comparable_types legacy tal tbl)
                    (fun tk =>
                      ((Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t tk
                        value tname), ctxt)))))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t ea tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Set_t eb tn2) =>
      op_gtgtquestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          op_gtpipequestion (merge_comparable_types legacy ea eb)
            (fun e =>
              ((Tezos_raw_protocol_alpha.Script_typed_ir.Set_t e tname), ctxt)))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (tal, l_field1, l_var1)
        (tar, r_field1, r_var1) tn1 has_big_map,
        Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (tbl, l_field2, l_var2)
          (tbr, r_field2, r_var2) tn2 _) =>
      op_gtgtquestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          op_gtgtquestion (merge_field_annot legacy l_field1 l_field2)
            (fun l_field =>
              op_gtgtquestion (merge_field_annot legacy r_field1 r_field2)
                (fun r_field =>
                  let l_var := merge_var_annot l_var1 l_var2 in
                  let r_var := merge_var_annot r_var1 r_var2 in
                  op_gtgtquestion (help ctxt tal tbl)
                    (fun function_parameter =>
                      let '(left_ty, ctxt) := function_parameter in
                      op_gtpipequestion (help ctxt tar tbr)
                        (fun function_parameter =>
                          let '(right_ty, ctxt) := function_parameter in
                          ((Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                            (left_ty, l_field, l_var) (right_ty, r_field, r_var)
                            tname has_big_map), ctxt))))))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tal, tal_annot)
        (tar, tar_annot) tn1 has_big_map,
        Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tbl, tbl_annot)
          (tbr, tbr_annot) tn2 _) =>
      op_gtgtquestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          op_gtgtquestion (merge_field_annot legacy tal_annot tbl_annot)
            (fun left_annot =>
              op_gtgtquestion (merge_field_annot legacy tar_annot tbr_annot)
                (fun right_annot =>
                  op_gtgtquestion (help ctxt tal tbl)
                    (fun function_parameter =>
                      let '(left_ty, ctxt) := function_parameter in
                      op_gtpipequestion (help ctxt tar tbr)
                        (fun function_parameter =>
                          let '(right_ty, ctxt) := function_parameter in
                          ((Tezos_raw_protocol_alpha.Script_typed_ir.Union_t
                            (left_ty, left_annot) (right_ty, right_annot) tname
                            has_big_map), ctxt))))))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t tal tar tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t tbl tbr tn2) =>
      op_gtgtquestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          op_gtgtquestion (help ctxt tal tbl)
            (fun function_parameter =>
              let '(left_ty, ctxt) := function_parameter in
              op_gtpipequestion (help ctxt tar tbr)
                (fun function_parameter =>
                  let '(right_ty, ctxt) := function_parameter in
                  ((Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t left_ty
                    right_ty tname), ctxt))))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t tal tn1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t tbl tn2) =>
      op_gtgtquestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          op_gtpipequestion (help ctxt tal tbl)
            (fun function_parameter =>
              let '(arg_ty, ctxt) := function_parameter in
              ((Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t arg_ty tname),
                ctxt)))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t tva tn1 has_big_map,
        Tezos_raw_protocol_alpha.Script_typed_ir.Option_t tvb tn2 _) =>
      op_gtgtquestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          op_gtpipequestion (help ctxt tva tvb)
            (fun function_parameter =>
              let '(ty, ctxt) := function_parameter in
              ((Tezos_raw_protocol_alpha.Script_typed_ir.Option_t ty tname
                has_big_map), ctxt)))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.List_t tva tn1 has_big_map,
        Tezos_raw_protocol_alpha.Script_typed_ir.List_t tvb tn2 _) =>
      op_gtgtquestion (merge_type_annot legacy tn1 tn2)
        (fun tname =>
          op_gtpipequestion (help ctxt tva tvb)
            (fun function_parameter =>
              let '(ty, ctxt) := function_parameter in
              ((Tezos_raw_protocol_alpha.Script_typed_ir.List_t ty tname
                has_big_map), ctxt)))
    | (_, _) =>
      (* ❌ Assert instruction is not handled. *)
      assert false
    end in
  fun ctxt =>
    fun loc =>
      fun ty1 =>
        fun ty2 =>
          record_inconsistent_type_annotations ctxt loc ty1 ty2
            (help ctxt ty1 ty2).

Definition merge_stacks {ta : Type}
  (legacy : bool) (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  : Tezos_raw_protocol_alpha.Alpha_context.context ->
    Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty ta ->
      Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty ta ->
        Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty ta *
            Tezos_raw_protocol_alpha.Alpha_context.context) :=
  let fix help {a : Type}
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (stack1 :
    Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty a) (stack2 :
    Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty a)
    : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty a *
        Tezos_raw_protocol_alpha.Alpha_context.context) :=
    match (stack1, stack2) with
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t,
        Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t) =>
      ok (Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t, ctxt)
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ty1 rest1 annot1,
        Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ty2 rest2 annot2) =>
      let annot := merge_var_annot annot1 annot2 in
      op_gtgtquestion (merge_types legacy ctxt loc ty1 ty2)
        (fun function_parameter =>
          let '(ty, ctxt) := function_parameter in
          op_gtpipequestion (help ctxt rest1 rest2)
            (fun function_parameter =>
              let '(rest, ctxt) := function_parameter in
              ((Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ty rest annot),
                ctxt)))
    end in
  help.

Definition has_big_map {t : Type}
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.ty t) : bool :=
  match function_parameter with
  | Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.String_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t _ _ _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Set_t _ _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t _ _ _ => true
  | Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t _ _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _ => false
  | Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t _ _ _ has_big_map =>
    has_big_map
  | Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ _ _ has_big_map =>
    has_big_map
  | Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ has_big_map =>
    has_big_map
  | Tezos_raw_protocol_alpha.Script_typed_ir.List_t _ _ has_big_map =>
    has_big_map
  | Tezos_raw_protocol_alpha.Script_typed_ir.Map_t _ _ _ has_big_map =>
    has_big_map
  end.

Reserved Notation "'judgement".

Inductive judgement_gadt : Type :=
| Typed : forall {aft bef : Type},
  Tezos_raw_protocol_alpha.Script_typed_ir.descr bef aft -> judgement_gadt
| Failed : forall {aft bef : Type},
  (Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty aft ->
    Tezos_raw_protocol_alpha.Script_typed_ir.descr bef aft) * (aft) ->
  judgement_gadt

where "'judgement" := (fun (bef : Type) => judgement_gadt).

Definition judgement := 'judgement.

Record branch {t f b : Type} := {
  branch :
    (Tezos_raw_protocol_alpha.Script_typed_ir.descr t r ->
      Tezos_raw_protocol_alpha.Script_typed_ir.descr f r ->
        Tezos_raw_protocol_alpha.Script_typed_ir.descr b r) * (r) }.
Arguments branch : clear implicits.

Definition merge_branches {a b bef : Type}
  (legacy : bool) (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (loc : Z) (btr : judgement a) (bfr : judgement b)
  (function_parameter : branch a b bef)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (judgement bef * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let '{| branch := branch |} := function_parameter in
  match (btr, bfr) with
  | (Typed ({| aft := aftbt |} as dbt), Typed ({| aft := aftbf |} as dbf)) =>
    let unmatched_branches (function_parameter : unit)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_protocol_environment_alpha__Environment.Error_monad.error) :=
      let 'tt := function_parameter in
      op_gtgteqquestion (serialize_stack_for_error ctxt aftbt)
        (fun function_parameter =>
          let '(aftbt, ctxt) := function_parameter in
          op_gtgtpipequestion (serialize_stack_for_error ctxt aftbf)
            (fun function_parameter =>
              let '(aftbf, _ctxt) := function_parameter in
              Tezos_protocol_environment_alpha__Environment.Error_monad.Unmatched_branches
                loc aftbt aftbf)) in
    trace_eval unmatched_branches
      (op_gtgteqquestion (Lwt.__return (stack_ty_eq ctxt 1 aftbt aftbf))
        (fun function_parameter =>
          let '(Eq, ctxt) := function_parameter in
          op_gtgteqquestion
            (Lwt.__return (merge_stacks legacy loc ctxt aftbt aftbf))
            (fun function_parameter =>
              let '(merged_stack, ctxt) := function_parameter in
              __return
                ((Typed
                  (branch
                    (* ❌ Record substitution not handled *)
                    record_substitution
                    (* ❌ Record substitution not handled *)
                    record_substitution)), ctxt))))
  | (Failed {| descr := descrt |}, Failed {| descr := descrf |}) =>
    let descr {D : Type}
      (ret : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty D)
      : Tezos_raw_protocol_alpha.Script_typed_ir.descr bef D :=
      branch (descrt ret) (descrf ret) in
    __return ((Failed {| descr := descr |}), ctxt)
  | (Typed dbt, Failed {| descr := descrf |}) =>
    __return ((Typed (branch dbt (descrf (aft dbt)))), ctxt)
  | (Failed {| descr := descrt |}, Typed dbf) =>
    __return ((Typed (branch (descrt (aft dbf)) dbf)), ctxt)
  end.

Fixpoint parse_comparable_ty
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (ty : Tezos_raw_protocol_alpha.Alpha_context.Script.node)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (ex_comparable_ty * Tezos_raw_protocol_alpha.Alpha_context.context) :=
  op_gtgtquestion (Gas.consume ctxt Typecheck_costs.cycle)
    (fun ctxt =>
      op_gtgtquestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
        (fun ctxt =>
          match ty with
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.T_int [] annot =>
            op_gtpipequestion (parse_type_annot loc annot)
              (fun tname =>
                ((Ex_comparable_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Int_key tname)),
                  ctxt))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.T_nat [] annot =>
            op_gtpipequestion (parse_type_annot loc annot)
              (fun tname =>
                ((Ex_comparable_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_key tname)),
                  ctxt))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.T_string [] annot =>
            op_gtpipequestion (parse_type_annot loc annot)
              (fun tname =>
                ((Ex_comparable_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.String_key tname)),
                  ctxt))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.T_bytes [] annot =>
            op_gtpipequestion (parse_type_annot loc annot)
              (fun tname =>
                ((Ex_comparable_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_key tname)),
                  ctxt))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.T_mutez [] annot =>
            op_gtpipequestion (parse_type_annot loc annot)
              (fun tname =>
                ((Ex_comparable_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_key tname)),
                  ctxt))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.T_bool [] annot =>
            op_gtpipequestion (parse_type_annot loc annot)
              (fun tname =>
                ((Ex_comparable_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_key tname)),
                  ctxt))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.T_key_hash [] annot
            =>
            op_gtpipequestion (parse_type_annot loc annot)
              (fun tname =>
                ((Ex_comparable_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_key tname)),
                  ctxt))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.T_timestamp [] annot
            =>
            op_gtpipequestion (parse_type_annot loc annot)
              (fun tname =>
                ((Ex_comparable_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_key tname)),
                  ctxt))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.T_address [] annot
            =>
            op_gtpipequestion (parse_type_annot loc annot)
              (fun tname =>
                ((Ex_comparable_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Address_key tname)),
                  ctxt))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              ((Tezos_raw_protocol_alpha.Alpha_context.Script.T_int |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_nat |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_string |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_mutez |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_bool |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_key |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_address |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_timestamp) as
                prim) l _ =>
            error
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
                loc prim 0 (List.length l))
          |
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              (Tezos_raw_protocol_alpha.Alpha_context.Script.T_pair |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_or |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_set |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_map |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_list |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_option |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_lambda |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_unit |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_signature |
                Tezos_raw_protocol_alpha.Alpha_context.Script.T_contract) _ _ =>
            error
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Comparable_type_expected
                loc (Micheline.strip_locations ty))
          | expr =>
            op_atat error
              (unexpected expr []
                Tezos_raw_protocol_alpha.Script_tc_errors.Type_namespace
                (cons Tezos_raw_protocol_alpha.Alpha_context.Script.T_int
                  (cons Tezos_raw_protocol_alpha.Alpha_context.Script.T_nat
                    (cons Tezos_raw_protocol_alpha.Alpha_context.Script.T_string
                      (cons
                        Tezos_raw_protocol_alpha.Alpha_context.Script.T_mutez
                        (cons
                          Tezos_raw_protocol_alpha.Alpha_context.Script.T_bool
                          (cons
                            Tezos_raw_protocol_alpha.Alpha_context.Script.T_key
                            (cons
                              Tezos_raw_protocol_alpha.Alpha_context.Script.T_key_hash
                              (cons
                                Tezos_raw_protocol_alpha.Alpha_context.Script.T_timestamp
                                [])))))))))
          end))

with parse_packable_ty
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (legacy : bool)
  : Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (ex_ty * Tezos_raw_protocol_alpha.Alpha_context.context) :=
  parse_ty ctxt legacy false false legacy

with parse_parameter_ty
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (legacy : bool)
  : Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (ex_ty * Tezos_raw_protocol_alpha.Alpha_context.context) :=
  parse_ty ctxt legacy true false true

with parse_any_ty
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (legacy : bool)
  : Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (ex_ty * Tezos_raw_protocol_alpha.Alpha_context.context) :=
  parse_ty ctxt legacy true true true

with parse_ty
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (legacy : bool)
  (allow_big_map : bool) (allow_operation : bool) (allow_contract : bool)
  (node : Tezos_raw_protocol_alpha.Alpha_context.Script.node)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (ex_ty * Tezos_raw_protocol_alpha.Alpha_context.context) :=
  op_gtgtquestion (Gas.consume ctxt Typecheck_costs.cycle)
    (fun ctxt =>
      match node with
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_unit [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_int [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_nat [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_string [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.String_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_bytes [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_mutez [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_bool [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_key [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_key_hash [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_timestamp [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_address [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_signature [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_operation [] annot =>
        if allow_operation then
          op_gtgtquestion (parse_type_annot loc annot)
            (fun ty_name =>
              op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
                (fun ctxt =>
                  ((Ex_ty
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t
                      ty_name)), ctxt)))
        else
          error
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_operation
              loc)
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_chain_id [] annot =>
        op_gtgtquestion (parse_type_annot loc annot)
          (fun ty_name =>
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 0))
              (fun ctxt =>
                ((Ex_ty
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t ty_name)),
                  ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_contract (cons utl [])
          annot =>
        if allow_contract then
          op_gtgtquestion (parse_parameter_ty ctxt legacy utl)
            (fun function_parameter =>
              let '(Ex_ty tl, ctxt) := function_parameter in
              op_gtgtquestion (parse_type_annot loc annot)
                (fun ty_name =>
                  op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 1))
                    (fun ctxt =>
                      ((Ex_ty
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t tl
                          ty_name)), ctxt))))
        else
          error
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_contract
              loc)
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_pair
          (cons utl (cons utr [])) annot =>
        op_gtgtquestion (extract_field_annot utl)
          (fun function_parameter =>
            let '(utl, left_field) := function_parameter in
            op_gtgtquestion (extract_field_annot utr)
              (fun function_parameter =>
                let '(utr, right_field) := function_parameter in
                op_gtgtquestion
                  (parse_ty ctxt legacy allow_big_map allow_operation
                    allow_contract utl)
                  (fun function_parameter =>
                    let '(Ex_ty tl, ctxt) := function_parameter in
                    op_gtgtquestion
                      (parse_ty ctxt legacy allow_big_map allow_operation
                        allow_contract utr)
                      (fun function_parameter =>
                        let '(Ex_ty tr, ctxt) := function_parameter in
                        op_gtgtquestion (parse_type_annot loc annot)
                          (fun ty_name =>
                            op_gtpipequestion
                              (Gas.consume ctxt (Typecheck_costs.type_ 2))
                              (fun ctxt =>
                                ((Ex_ty
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                                    (tl, left_field, None)
                                    (tr, right_field, None) ty_name
                                    (op_pipepipe (has_big_map tl)
                                      (has_big_map tr)))), ctxt)))))))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_or
          (cons utl (cons utr [])) annot =>
        op_gtgtquestion (extract_field_annot utl)
          (fun function_parameter =>
            let '(utl, left_constr) := function_parameter in
            op_gtgtquestion (extract_field_annot utr)
              (fun function_parameter =>
                let '(utr, right_constr) := function_parameter in
                op_gtgtquestion
                  (parse_ty ctxt legacy allow_big_map allow_operation
                    allow_contract utl)
                  (fun function_parameter =>
                    let '(Ex_ty tl, ctxt) := function_parameter in
                    op_gtgtquestion
                      (parse_ty ctxt legacy allow_big_map allow_operation
                        allow_contract utr)
                      (fun function_parameter =>
                        let '(Ex_ty tr, ctxt) := function_parameter in
                        op_gtgtquestion (parse_type_annot loc annot)
                          (fun ty_name =>
                            op_gtpipequestion
                              (Gas.consume ctxt (Typecheck_costs.type_ 2))
                              (fun ctxt =>
                                ((Ex_ty
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t
                                    (tl, left_constr) (tr, right_constr) ty_name
                                    (op_pipepipe (has_big_map tl)
                                      (has_big_map tr)))), ctxt)))))))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_lambda
          (cons uta (cons utr [])) annot =>
        op_gtgtquestion (parse_any_ty ctxt legacy uta)
          (fun function_parameter =>
            let '(Ex_ty ta, ctxt) := function_parameter in
            op_gtgtquestion (parse_any_ty ctxt legacy utr)
              (fun function_parameter =>
                let '(Ex_ty tr, ctxt) := function_parameter in
                op_gtgtquestion (parse_type_annot loc annot)
                  (fun ty_name =>
                    op_gtpipequestion
                      (Gas.consume ctxt (Typecheck_costs.type_ 2))
                      (fun ctxt =>
                        ((Ex_ty
                          (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t ta
                            tr ty_name)), ctxt)))))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_option (cons ut [])
          annot =>
        op_gtgtquestion
          (if legacy then
            op_gtgtquestion (extract_field_annot ut)
              (fun function_parameter =>
                let '(ut, _some_constr) := function_parameter in
                op_gtgtquestion (parse_composed_type_annot loc annot)
                  (fun function_parameter =>
                    let '(ty_name, _none_constr, _) := function_parameter in
                    ok (ut, ty_name)))
          else
            op_gtgtquestion (parse_type_annot loc annot)
              (fun ty_name => ok (ut, ty_name)))
          (fun function_parameter =>
            let '(ut, ty_name) := function_parameter in
            op_gtgtquestion
              (parse_ty ctxt legacy allow_big_map allow_operation allow_contract
                ut)
              (fun function_parameter =>
                let '(Ex_ty t, ctxt) := function_parameter in
                op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 2))
                  (fun ctxt =>
                    ((Ex_ty
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t t
                        ty_name (has_big_map t))), ctxt))))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_list (cons ut [])
          annot =>
        op_gtgtquestion
          (parse_ty ctxt legacy allow_big_map allow_operation allow_contract ut)
          (fun function_parameter =>
            let '(Ex_ty t, ctxt) := function_parameter in
            op_gtgtquestion (parse_type_annot loc annot)
              (fun ty_name =>
                op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 1))
                  (fun ctxt =>
                    ((Ex_ty
                      (Tezos_raw_protocol_alpha.Script_typed_ir.List_t t ty_name
                        (has_big_map t))), ctxt))))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_set (cons ut []) annot
        =>
        op_gtgtquestion (parse_comparable_ty ctxt ut)
          (fun function_parameter =>
            let '(Ex_comparable_ty t, ctxt) := function_parameter in
            op_gtgtquestion (parse_type_annot loc annot)
              (fun ty_name =>
                op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 1))
                  (fun ctxt =>
                    ((Ex_ty
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t t ty_name)),
                      ctxt))))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_map
          (cons uta (cons utr [])) annot =>
        op_gtgtquestion (parse_comparable_ty ctxt uta)
          (fun function_parameter =>
            let '(Ex_comparable_ty ta, ctxt) := function_parameter in
            op_gtgtquestion
              (parse_ty ctxt legacy allow_big_map allow_operation allow_contract
                utr)
              (fun function_parameter =>
                let '(Ex_ty tr, ctxt) := function_parameter in
                op_gtgtquestion (parse_type_annot loc annot)
                  (fun ty_name =>
                    op_gtpipequestion
                      (Gas.consume ctxt (Typecheck_costs.type_ 2))
                      (fun ctxt =>
                        ((Ex_ty
                          (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t ta tr
                            ty_name (has_big_map tr))), ctxt)))))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_big_map args annot =>
        op_gtgtquestion (parse_big_map_ty ctxt legacy loc args annot)
          (fun function_parameter =>
            let '(big_map_ty, ctxt) := function_parameter in
            op_gtpipequestion (Gas.consume ctxt (Typecheck_costs.type_ 2))
              (fun ctxt => (big_map_ty, ctxt)))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.T_big_map _ _ =>
        error
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_big_map
            loc)
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.T_unit |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_signature |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_int |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_nat |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_string |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_bytes |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_mutez |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_bool |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_key |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_key_hash |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_timestamp |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_address) as prim) l
          _ =>
        error
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc prim 0 (List.length l))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.T_set |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_list |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_option |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_contract) as prim) l
          _ =>
        error
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc prim 1 (List.length l))
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.T_pair |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_or |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_map |
            Tezos_raw_protocol_alpha.Alpha_context.Script.T_lambda) as prim) l _
        =>
        error
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc prim 2 (List.length l))
      | expr =>
        op_atat error
          (unexpected expr []
            Tezos_raw_protocol_alpha.Script_tc_errors.Type_namespace
            (cons Tezos_raw_protocol_alpha.Alpha_context.Script.T_pair
              (cons Tezos_raw_protocol_alpha.Alpha_context.Script.T_or
                (cons Tezos_raw_protocol_alpha.Alpha_context.Script.T_set
                  (cons Tezos_raw_protocol_alpha.Alpha_context.Script.T_map
                    (cons Tezos_raw_protocol_alpha.Alpha_context.Script.T_list
                      (cons
                        Tezos_raw_protocol_alpha.Alpha_context.Script.T_option
                        (cons
                          Tezos_raw_protocol_alpha.Alpha_context.Script.T_lambda
                          (cons
                            Tezos_raw_protocol_alpha.Alpha_context.Script.T_unit
                            (cons
                              Tezos_raw_protocol_alpha.Alpha_context.Script.T_signature
                              (cons
                                Tezos_raw_protocol_alpha.Alpha_context.Script.T_contract
                                (cons
                                  Tezos_raw_protocol_alpha.Alpha_context.Script.T_int
                                  (cons
                                    Tezos_raw_protocol_alpha.Alpha_context.Script.T_nat
                                    (cons
                                      Tezos_raw_protocol_alpha.Alpha_context.Script.T_operation
                                      (cons
                                        Tezos_raw_protocol_alpha.Alpha_context.Script.T_string
                                        (cons
                                          Tezos_raw_protocol_alpha.Alpha_context.Script.T_bytes
                                          (cons
                                            Tezos_raw_protocol_alpha.Alpha_context.Script.T_mutez
                                            (cons
                                              Tezos_raw_protocol_alpha.Alpha_context.Script.T_bool
                                              (cons
                                                Tezos_raw_protocol_alpha.Alpha_context.Script.T_key
                                                (cons
                                                  Tezos_raw_protocol_alpha.Alpha_context.Script.T_key_hash
                                                  (cons
                                                    Tezos_raw_protocol_alpha.Alpha_context.Script.T_timestamp
                                                    (cons
                                                      Tezos_raw_protocol_alpha.Alpha_context.Script.T_chain_id
                                                      []))))))))))))))))))))))
      end)

with parse_big_map_ty
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context) (legacy : bool)
  (big_map_loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (args :
    list
      (Tezos_protocol_environment_alpha__Environment.Micheline.node
        Tezos_raw_protocol_alpha.Alpha_context.Script.location
        Tezos_raw_protocol_alpha.Alpha_context.Script.prim))
  (map_annot : Tezos_protocol_environment_alpha__Environment.Micheline.annot)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (ex_ty * Tezos_raw_protocol_alpha__Alpha_context.context) :=
  op_gtgtquestion (Gas.consume ctxt Typecheck_costs.cycle)
    (fun ctxt =>
      match args with
      | cons key_ty (cons value_ty []) =>
        op_gtgtquestion (parse_comparable_ty ctxt key_ty)
          (fun function_parameter =>
            let '(Ex_comparable_ty key_ty, ctxt) := function_parameter in
            op_gtgtquestion (parse_packable_ty ctxt legacy value_ty)
              (fun function_parameter =>
                let '(Ex_ty value_ty, ctxt) := function_parameter in
                op_gtpipequestion (parse_type_annot big_map_loc map_annot)
                  (fun map_name =>
                    let big_map_ty :=
                      Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t key_ty
                        value_ty map_name in
                    ((Ex_ty big_map_ty), ctxt))))
      | args =>
        op_atat error
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            big_map_loc Tezos_raw_protocol_alpha.Alpha_context.Script.T_big_map
            2 (List.length args))
      end)

with parse_storage_ty
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (legacy : bool)
  (node : Tezos_raw_protocol_alpha.Alpha_context.Script.node)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (ex_ty * Tezos_raw_protocol_alpha.Alpha_context.context) :=
  match node with
  |
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
      Tezos_raw_protocol_alpha.Alpha_context.Script.T_pair
      (cons
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
          big_map_loc Tezos_raw_protocol_alpha.Alpha_context.Script.T_big_map
          args map_annot) (cons remaining_storage [])) storage_annot =>
    match storage_annot with
    | [] => parse_ty ctxt legacy true false legacy node
    | cons single [] => parse_ty ctxt legacy true false legacy node
    | _ =>
      op_gtgtquestion (Gas.consume ctxt Typecheck_costs.cycle)
        (fun ctxt =>
          op_gtgtquestion
            (parse_big_map_ty ctxt legacy big_map_loc args map_annot)
            (fun function_parameter =>
              let '(Ex_ty big_map_ty, ctxt) := function_parameter in
              op_gtgtquestion
                (parse_ty ctxt legacy true false legacy remaining_storage)
                (fun function_parameter =>
                  let '(Ex_ty remaining_storage, ctxt) := function_parameter in
                  op_gtgtquestion (parse_composed_type_annot loc storage_annot)
                    (fun function_parameter =>
                      let '(ty_name, map_field, storage_field) :=
                        function_parameter in
                      op_gtpipequestion
                        (Gas.consume ctxt (Typecheck_costs.type_ 5))
                        (fun ctxt =>
                          ((Ex_ty
                            (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                              (big_map_ty, map_field, None)
                              (remaining_storage, storage_field, None) ty_name
                              true)), ctxt))))))
    end
  | _ => parse_ty ctxt legacy true false legacy node
  end.

Definition check_packable {A : Type}
  (legacy : bool) (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (root : Tezos_raw_protocol_alpha.Script_typed_ir.ty A)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
  let fix check {t : Type}
    (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.ty t)
    : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
    match function_parameter with
    | Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t _ _ _ =>
      error
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_big_map
          loc)
    | Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t _ =>
      error
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_operation
          loc)
    | Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.String_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _ => ok tt
    |
      Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (l_ty, _, _) (r_ty, _, _)
        _ _ =>
      op_gtgtquestion (check l_ty)
        (fun function_parameter =>
          let 'tt := function_parameter in
          check r_ty)
    | Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (l_ty, _) (r_ty, _) _ _
      =>
      op_gtgtquestion (check l_ty)
        (fun function_parameter =>
          let 'tt := function_parameter in
          check r_ty)
    | Tezos_raw_protocol_alpha.Script_typed_ir.Option_t v_ty _ _ => check v_ty
    | Tezos_raw_protocol_alpha.Script_typed_ir.List_t elt_ty _ _ => check elt_ty
    | Tezos_raw_protocol_alpha.Script_typed_ir.Set_t _ _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Map_t _ elt_ty _ _ =>
      check elt_ty
    | Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t _l_ty _r_ty _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t _ _ => ok tt
    | Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t _ _ =>
      error
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_contract
          loc)
    end in
  check root.

Reserved Notation "'ex_script".

Inductive ex_script_gadt : Type :=
| Ex_script : forall {a c : Type},
  Tezos_raw_protocol_alpha.Script_typed_ir.script a c -> ex_script_gadt

where "'ex_script" := (ex_script_gadt).

Definition ex_script := 'ex_script.

Reserved Notation "'dig_proof_argument".

Inductive dig_proof_argument_gadt : Type :=
| Dig_proof_argument : forall {aft bef rest x : Type},
  Tezos_raw_protocol_alpha.Script_typed_ir.stack_prefix_preservation_witness
    (x * rest) rest bef aft *
    (Tezos_raw_protocol_alpha.Script_typed_ir.ty x *
      option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot) *
    Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty aft ->
  dig_proof_argument_gadt

where "'dig_proof_argument" := (fun (_ : Type) => dig_proof_argument_gadt).

Definition dig_proof_argument := 'dig_proof_argument.

Reserved Notation "'dug_proof_argument".

Inductive dug_proof_argument_gadt : Type :=
| Dug_proof_argument : forall {aft bef rest x : Type},
  Tezos_raw_protocol_alpha.Script_typed_ir.stack_prefix_preservation_witness
    rest (x * rest) bef aft * unit *
    Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty aft ->
  dug_proof_argument_gadt

where "'dug_proof_argument" := (fun (_ _ : Type) => dug_proof_argument_gadt).

Definition dug_proof_argument := 'dug_proof_argument.

Reserved Notation "'dipn_proof_argument".

Inductive dipn_proof_argument_gadt : Type :=
| Dipn_proof_argument : forall {aft bef faft fbef : Type},
  Tezos_raw_protocol_alpha.Script_typed_ir.stack_prefix_preservation_witness
    fbef faft bef aft *
    (Tezos_raw_protocol_alpha.Alpha_context.context *
      Tezos_raw_protocol_alpha.Script_typed_ir.descr fbef faft) *
    Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty aft ->
  dipn_proof_argument_gadt

where "'dipn_proof_argument" := (fun (_ : Type) => dipn_proof_argument_gadt).

Definition dipn_proof_argument := 'dipn_proof_argument.

Reserved Notation "'dropn_proof_argument".

Inductive dropn_proof_argument_gadt : Type :=
| Dropn_proof_argument : forall {aft bef rest : Type},
  Tezos_raw_protocol_alpha.Script_typed_ir.stack_prefix_preservation_witness
    rest rest bef aft * Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty rest *
    Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty aft ->
  dropn_proof_argument_gadt

where "'dropn_proof_argument" := (fun (_ : Type) => dropn_proof_argument_gadt).

Definition dropn_proof_argument := 'dropn_proof_argument.

Definition parse_var_annot
  (loc : Z)
  (default : option (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot))
  (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)) :=
  Lwt.__return (parse_var_annot loc default annot).

Definition parse_entrypoint_annot
  (loc : Z)
  (default : option (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot))
  (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
        option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)) :=
  Lwt.__return (parse_entrypoint_annot loc default annot).

Definition parse_constr_annot
  (loc : Z)
  (if_special_first :
    option (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot))
  (if_special_second :
    option (option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot))
  (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
        option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot *
        option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot *
        option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)) :=
  Lwt.__return (parse_constr_annot loc if_special_first if_special_second annot).

Definition parse_two_var_annot (loc : Z) (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
        option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)) :=
  Lwt.__return (parse_two_var_annot loc annot).

Definition parse_destr_annot
  (loc : Z) (annot : list string)
  (default_accessor :
    option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  (field_name : option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)
  (pair_annot : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  (value_annot : option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
        option Tezos_raw_protocol_alpha.Script_typed_ir.field_annot)) :=
  Lwt.__return
    (parse_destr_annot loc annot default_accessor field_name pair_annot
      value_annot).

Definition parse_var_type_annot (loc : Z) (annot : list string)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot *
        option Tezos_raw_protocol_alpha.Script_typed_ir.type_annot)) :=
  Lwt.__return (parse_var_type_annot loc annot).

Definition find_entrypoint {A : Type}
  (full : Tezos_raw_protocol_alpha.Script_typed_ir.ty A)
  (root_name :
    option
      Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  (entrypoint :
    Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    ((Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
      Tezos_raw_protocol_alpha.Alpha_context.Script.node) * ex_ty) :=
  let fix find_entrypoint {t : Type}
    (t : Tezos_raw_protocol_alpha.Script_typed_ir.ty t) (entrypoint : string)
    : (Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
      Tezos_raw_protocol_alpha.Alpha_context.Script.node) * ex_ty :=
    match t with
    | Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tl, al) (tr, ar) _ _ =>
      if
        match al with
        | None => false
        | Some (Field_annot l) =>
          Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
            l entrypoint
        end then
        ((fun e =>
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left (cons e []) []),
          (Ex_ty tl))
      else
        if
          match ar with
          | None => false
          | Some (Field_annot r) =>
            Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
              r entrypoint
          end then
          ((fun e =>
            Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
              Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right (cons e [])
              []), (Ex_ty tr))
        else
          (* ❌ Try-with are not handled *)
          try
            (let '(f, t) := find_entrypoint tl entrypoint in
            ((fun e =>
              Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
                Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left
                (cons (f e) []) []), t))
    | _ => raise OCaml.Not_found
    end in
  let entrypoint :=
    if
      Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
        entrypoint "" % string then
      "default" % string
    else
      entrypoint in
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
      (String.length entrypoint) 31 then
    error
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Entrypoint_name_too_long
        entrypoint)
  else
    match root_name with
    | Some root_name => ok ((fun e => e), (Ex_ty full))
    | _ =>
      (* ❌ Try-with are not handled *)
      try (ok (find_entrypoint full entrypoint))
    end.

Definition find_entrypoint_for_type {A B : Type}
  (full : Tezos_raw_protocol_alpha.Script_typed_ir.ty A)
  (expected : Tezos_raw_protocol_alpha.Script_typed_ir.ty B)
  (root_name :
    option
      Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  (entrypoint :
    Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_raw_protocol_alpha.Alpha_context.context * string *
      Tezos_raw_protocol_alpha.Script_typed_ir.ty B) :=
  match (entrypoint, root_name) with
  | ("default" % string, Some "root" % string) =>
    match find_entrypoint full root_name entrypoint with
    | (Tezos_protocol_environment_alpha__Environment.Pervasives.Error _) as err
      => err
    | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok (_, Ex_ty ty)
      =>
      match ty_eq ctxt expected ty with
      | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok (Eq, ctxt)
        => ok (ctxt, "default" % string, ty)
      | Tezos_protocol_environment_alpha__Environment.Pervasives.Error _ =>
        op_gtgtquestion (ty_eq ctxt expected full)
          (fun function_parameter =>
            let '(Eq, ctxt) := function_parameter in
            ok (ctxt, "root" % string, full))
      end
    end
  | _ =>
    op_gtgtquestion (find_entrypoint full root_name entrypoint)
      (fun function_parameter =>
        let '(_, Ex_ty ty) := function_parameter in
        op_gtgtquestion (ty_eq ctxt expected ty)
          (fun function_parameter =>
            let '(Eq, ctxt) := function_parameter in
            ok (ctxt, entrypoint, ty)))
  end.

(* ❌ Applications of functors are not handled. *)
functor_application

(* ❌ The definition of exceptions is not handled. *)
exception

(* ❌ The definition of exceptions is not handled. *)
exception

Definition well_formed_entrypoints {A : Type}
  (full : Tezos_raw_protocol_alpha.Script_typed_ir.ty A)
  (root_name :
    option Entrypoints.(Tezos_protocol_environment_alpha__Environment.SET.S.elt))
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit :=
  let merge {B C : Type}
    (path : list B) (annot : option variant) (ty :
    Tezos_raw_protocol_alpha.Script_typed_ir.ty C) (reachable : bool)
    (function_parameter :
    option (list B) *
      Entrypoints.(Tezos_protocol_environment_alpha__Environment.SET.S.t))
    : option (list B) *
      Entrypoints.(Tezos_protocol_environment_alpha__Environment.SET.S.t) :=
    let '(first_unreachable, all) as acc := function_parameter in
    match annot with
    | None | Some (Field_annot "" % string) =>
      if reachable then
        acc
      else
        match ty with
        | Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ _ _ _ => acc
        | _ =>
          match first_unreachable with
          | None => ((Some (List.rev path)), all)
          | Some _ => acc
          end
        end
    | Some (Field_annot name) =>
      if
        Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
          (String.length name) 31 then
        raise (Too_long name)
      else
        if
          Entrypoints.(Tezos_protocol_environment_alpha__Environment.SET.S.mem)
            name all then
          raise (Duplicate name)
        else
          (first_unreachable,
            (Entrypoints.(Tezos_protocol_environment_alpha__Environment.SET.S.add)
              name all))
    end in
  let fix check {t : Type}
    (t : Tezos_raw_protocol_alpha.Script_typed_ir.ty t) (path :
    list Tezos_raw_protocol_alpha.Alpha_context.Script.prim) (reachable : bool)
    (acc :
    option (list Tezos_raw_protocol_alpha.Alpha_context.Script.prim) *
      Entrypoints.(Tezos_protocol_environment_alpha__Environment.SET.S.t))
    : option (list Tezos_raw_protocol_alpha.Alpha_context.Script.prim) *
      Entrypoints.(Tezos_protocol_environment_alpha__Environment.SET.S.t) :=
    match t with
    | Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tl, al) (tr, ar) _ _ =>
      let acc :=
        merge (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left path)
          al tl reachable acc in
      let acc :=
        merge (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right path)
          ar tr reachable acc in
      let acc :=
        check tl
          (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left path)
          match al with
          | Some _ => true
          | None => reachable
          end acc in
      check tr (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right path)
        match ar with
        | Some _ => true
        | None => reachable
        end acc
    | _ => acc
    end in
  (* ❌ Try-with are not handled *)
  try
    (let '(init, reachable) :=
      match root_name with
      | None | Some "" % string =>
        (Entrypoints.(Tezos_protocol_environment_alpha__Environment.SET.S.empty),
          false)
      | Some name =>
        ((Entrypoints.(Tezos_protocol_environment_alpha__Environment.SET.S.singleton)
          name), true)
      end in
    let '(first_unreachable, all) := check full [] reachable (None, init) in
    if
      not
        (Entrypoints.(Tezos_protocol_environment_alpha__Environment.SET.S.mem)
          "default" % string all) then
      ok tt
    else
      match first_unreachable with
      | None => ok tt
      | Some path =>
        error
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Unreachable_entrypoint
            path)
      end).

Fixpoint parse_data {a : Type}
  (type_logger : option type_logger)
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (legacy : bool)
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.ty a)
  (script_data : Tezos_raw_protocol_alpha.Alpha_context.Script.node)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (a * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Typecheck_costs.cycle))
    (fun ctxt =>
      let error (function_parameter : unit)
        : Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_protocol_environment_alpha__Environment.Error_monad.error) :=
        let 'tt := function_parameter in
        op_gtgtpipequestion (Lwt.__return (serialize_ty_for_error ctxt ty))
          (fun function_parameter =>
            let '(ty, _ctxt) := function_parameter in
            Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_constant
              (location script_data) (strip_locations script_data) ty) in
      let traced {B : Type}
        (body :
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B))
        : Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
        trace_eval error body in
      let parse_items {B C D E : Type}
        (type_logger : option type_logger) (loc :
        Tezos_raw_protocol_alpha.Alpha_context.Script.location) (ctxt :
        Tezos_raw_protocol_alpha__Alpha_context.context) (expr :
        Tezos_protocol_environment_alpha__Environment.Micheline.node B
          Tezos_raw_protocol_alpha.Alpha_context.Script.prim) (key_type :
        Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty C) (value_type :
        Tezos_raw_protocol_alpha.Script_typed_ir.ty D) (items :
        list
          (Tezos_protocol_environment_alpha__Environment.Micheline.node
            Tezos_raw_protocol_alpha.Alpha_context.Script.location
            Tezos_raw_protocol_alpha.Alpha_context.Script.prim)) (item_wrapper :
        D -> E)
        : Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (Tezos_raw_protocol_alpha.Script_typed_ir.map C E *
              Tezos_raw_protocol_alpha__Alpha_context.context)) :=
        let length := List.length items in
        op_gtgtpipequestion
          (op_pipegt
            (fold_left_s
              (fun function_parameter =>
                let '(last_value, map, ctxt) := function_parameter in
                fun item =>
                  op_gtgteqquestion
                    (Lwt.__return
                      (Gas.consume ctxt (Typecheck_costs.map_element length)))
                    (fun ctxt =>
                      match item with
                      |
                        Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          _ Tezos_raw_protocol_alpha.Alpha_context.Script.D_Elt
                          (cons k (cons v [])) _ =>
                        op_gtgteqquestion
                          (parse_comparable_data type_logger ctxt key_type k)
                          (fun function_parameter =>
                            let '(k, ctxt) := function_parameter in
                            op_gtgteqquestion
                              (parse_data type_logger ctxt legacy value_type v)
                              (fun function_parameter =>
                                let '(v, ctxt) := function_parameter in
                                op_gtgteqquestion
                                  match last_value with
                                  | Some value =>
                                    if
                                      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lteq)
                                        0 (compare_comparable key_type value k)
                                      then
                                      if
                                        Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
                                          0
                                          (compare_comparable key_type value k)
                                        then
                                        fail
                                          (Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_map_keys
                                            loc (strip_locations expr))
                                      else
                                        fail
                                          (Tezos_protocol_environment_alpha__Environment.Error_monad.Unordered_map_keys
                                            loc (strip_locations expr))
                                    else
                                      return_unit
                                  | None => return_unit
                                  end
                                  (fun function_parameter =>
                                    let 'tt := function_parameter in
                                    __return
                                      ((Some k),
                                        (map_update k (Some (item_wrapper v))
                                          map), ctxt))))
                      |
                        Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          loc
                          Tezos_raw_protocol_alpha.Alpha_context.Script.D_Elt l
                          _ =>
                        op_atat fail
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
                            loc
                            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Elt
                            2 (List.length l))
                      |
                        Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          loc name _ _ =>
                        op_atat fail
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_primitive
                            loc
                            (cons
                              Tezos_raw_protocol_alpha.Alpha_context.Script.D_Elt
                              []) name)
                      |
                        Tezos_protocol_environment_alpha__Environment.Micheline.Int
                          _ _ |
                          Tezos_protocol_environment_alpha__Environment.Micheline.String
                            _ _ |
                          Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                            _ _ |
                          Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                            _ _ => op_gtgteqquestion (error tt) fail
                      end)) (None, (empty_map key_type), ctxt) items) traced)
          (fun function_parameter =>
            let '(_, items, ctxt) := function_parameter in
            (items, ctxt)) in
      match (ty, script_data) with
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Unit [] annot) =>
        op_gtgteqquestion
          (if legacy then
            __return tt
          else
            fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgtpipequestion
              (Lwt.__return (Gas.consume ctxt Typecheck_costs.unit))
              (fun ctxt => (tt, ctxt)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Unit l _) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
              loc Tezos_raw_protocol_alpha.Alpha_context.Script.D_Unit 0
              (List.length l)))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _, expr) =>
        traced
          (fail
            (unexpected expr []
              Tezos_raw_protocol_alpha.Script_tc_errors.Constant_namespace
              (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Unit [])))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_True [] annot) =>
        op_gtgteqquestion
          (if legacy then
            __return tt
          else
            fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgtpipequestion
              (Lwt.__return (Gas.consume ctxt Typecheck_costs.bool))
              (fun ctxt => (true, ctxt)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_False [] annot) =>
        op_gtgteqquestion
          (if legacy then
            __return tt
          else
            fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgtpipequestion
              (Lwt.__return (Gas.consume ctxt Typecheck_costs.bool))
              (fun ctxt => (false, ctxt)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            ((Tezos_raw_protocol_alpha.Alpha_context.Script.D_True |
              Tezos_raw_protocol_alpha.Alpha_context.Script.D_False) as c) l _)
        =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
              loc c 0 (List.length l)))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _, expr) =>
        traced
          (fail
            (unexpected expr []
              Tezos_raw_protocol_alpha.Script_tc_errors.Constant_namespace
              (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_True
                (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_False []))))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.String_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.String _ v) =>
        op_gtgteqquestion
          (Lwt.__return
            (Gas.consume ctxt (Typecheck_costs.string (String.length v))))
          (fun ctxt =>
            let fix check_printable_ascii
              (i :
              Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
              : bool :=
              if
                Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
                  i 0 then
                true
              else
                match String.get v i with
                |
                  "010" % char |
                    " " % char |
                      "!" % char |
                        """" % char |
                          "#" % char |
                            "$" % char |
                              "%" % char |
                                "&" % char |
                                  "'" % char |
                                    "(" % char |
                                      ")" % char |
                                        "*" % char |
                                          "+" % char |
                                            "," % char |
                                              "-" % char |
                                                "." % char |
                                                  "/" % char |
                                                    "0" % char |
                                                      "1" % char |
                                                        "2" % char |
                                                          "3" % char |
                                                            "4" % char |
                                                              "5" % char |
                                                                "6" % char |
                                                                  "7" % char |
                                                                    "8" % char |
                                                                      "9" % char
                                                                        |
                                                                        ":" %
                                                                          char |
                                                                          ";" %
                                                                            char
                                                                            |
                                                                            "<"
                                                                              %
                                                                              char
                                                                              |
                                                                              "="
                                                                                %
                                                                                char
                                                                                |
                                                                                ">"
                                                                                  %
                                                                                  char
                                                                                  |
                                                                                  "?"
                                                                                    %
                                                                                    char
                                                                                    |
                                                                                    "@"
                                                                                      %
                                                                                      char
                                                                                      |
                                                                                      "A"
                                                                                        %
                                                                                        char
                                                                                        |
                                                                                        "B"
                                                                                          %
                                                                                          char
                                                                                          |
                                                                                          "C"
                                                                                            %
                                                                                            char
                                                                                            |
                                                                                            "D"
                                                                                              %
                                                                                              char
                                                                                              |
                                                                                              "E"
                                                                                                %
                                                                                                char
                                                                                                |
                                                                                                "F"
                                                                                                  %
                                                                                                  char
                                                                                                  |
                                                                                                  "G"
                                                                                                    %
                                                                                                    char
                                                                                                    |
                                                                                                    "H"
                                                                                                      %
                                                                                                      char
                                                                                                      |
                                                                                                      "I"
                                                                                                        %
                                                                                                        char
                                                                                                        |
                                                                                                        "J"
                                                                                                          %
                                                                                                          char
                                                                                                          |
                                                                                                          "K"
                                                                                                            %
                                                                                                            char
                                                                                                            |
                                                                                                            "L"
                                                                                                              %
                                                                                                              char
                                                                                                              |
                                                                                                              "M"
                                                                                                                %
                                                                                                                char
                                                                                                                |
                                                                                                                "N"
                                                                                                                  %
                                                                                                                  char
                                                                                                                  |
                                                                                                                  "O"
                                                                                                                    %
                                                                                                                    char
                                                                                                                    |
                                                                                                                    "P"
                                                                                                                      %
                                                                                                                      char
                                                                                                                      |
                                                                                                                      "Q"
                                                                                                                        %
                                                                                                                        char
                                                                                                                        |
                                                                                                                        "R"
                                                                                                                          %
                                                                                                                          char
                                                                                                                          |
                                                                                                                          "S"
                                                                                                                            %
                                                                                                                            char
                                                                                                                            |
                                                                                                                            "T"
                                                                                                                              %
                                                                                                                              char
                                                                                                                              |
                                                                                                                              "U"
                                                                                                                                %
                                                                                                                                char
                                                                                                                                |
                                                                                                                                "V"
                                                                                                                                  %
                                                                                                                                  char
                                                                                                                                  |
                                                                                                                                  "W"
                                                                                                                                    %
                                                                                                                                    char
                                                                                                                                    |
                                                                                                                                    "X"
                                                                                                                                      %
                                                                                                                                      char
                                                                                                                                      |
                                                                                                                                      "Y"
                                                                                                                                        %
                                                                                                                                        char
                                                                                                                                        |
                                                                                                                                        "Z"
                                                                                                                                          %
                                                                                                                                          char
                                                                                                                                          |
                                                                                                                                          "["
                                                                                                                                            %
                                                                                                                                            char
                                                                                                                                            |
                                                                                                                                            "\"
                                                                                                                                              %
                                                                                                                                              char
                                                                                                                                              |
                                                                                                                                              "]"
                                                                                                                                                %
                                                                                                                                                char
                                                                                                                                                |
                                                                                                                                                "^"
                                                                                                                                                  %
                                                                                                                                                  char
                                                                                                                                                  |
                                                                                                                                                  "_"
                                                                                                                                                    %
                                                                                                                                                    char
                                                                                                                                                    |
                                                                                                                                                    "`"
                                                                                                                                                      %
                                                                                                                                                      char
                                                                                                                                                      |
                                                                                                                                                      "a"
                                                                                                                                                        %
                                                                                                                                                        char
                                                                                                                                                        |
                                                                                                                                                        "b"
                                                                                                                                                          %
                                                                                                                                                          char
                                                                                                                                                          |
                                                                                                                                                          "c"
                                                                                                                                                            %
                                                                                                                                                            char
                                                                                                                                                            |
                                                                                                                                                            "d"
                                                                                                                                                              %
                                                                                                                                                              char
                                                                                                                                                              |
                                                                                                                                                              "e"
                                                                                                                                                                %
                                                                                                                                                                char
                                                                                                                                                                |
                                                                                                                                                                "f"
                                                                                                                                                                  %
                                                                                                                                                                  char
                                                                                                                                                                  |
                                                                                                                                                                  "g"
                                                                                                                                                                    %
                                                                                                                                                                    char
                                                                                                                                                                    |
                                                                                                                                                                    "h"
                                                                                                                                                                      %
                                                                                                                                                                      char
                                                                                                                                                                      |
                                                                                                                                                                      "i"
                                                                                                                                                                        %
                                                                                                                                                                        char
                                                                                                                                                                        |
                                                                                                                                                                        "j"
                                                                                                                                                                          %
                                                                                                                                                                          char
                                                                                                                                                                          |
                                                                                                                                                                          "k"
                                                                                                                                                                            %
                                                                                                                                                                            char
                                                                                                                                                                            |
                                                                                                                                                                            "l"
                                                                                                                                                                              %
                                                                                                                                                                              char
                                                                                                                                                                              |
                                                                                                                                                                              "m"
                                                                                                                                                                                %
                                                                                                                                                                                char
                                                                                                                                                                                |
                                                                                                                                                                                "n"
                                                                                                                                                                                  %
                                                                                                                                                                                  char
                                                                                                                                                                                  |
                                                                                                                                                                                  "o"
                                                                                                                                                                                    %
                                                                                                                                                                                    char
                                                                                                                                                                                    |
                                                                                                                                                                                    "p"
                                                                                                                                                                                      %
                                                                                                                                                                                      char
                                                                                                                                                                                      |
                                                                                                                                                                                      "q"
                                                                                                                                                                                        %
                                                                                                                                                                                        char
                                                                                                                                                                                        |
                                                                                                                                                                                        "r"
                                                                                                                                                                                          %
                                                                                                                                                                                          char
                                                                                                                                                                                          |
                                                                                                                                                                                          "s"
                                                                                                                                                                                            %
                                                                                                                                                                                            char
                                                                                                                                                                                            |
                                                                                                                                                                                            "t"
                                                                                                                                                                                              %
                                                                                                                                                                                              char
                                                                                                                                                                                              |
                                                                                                                                                                                              "u"
                                                                                                                                                                                                %
                                                                                                                                                                                                char
                                                                                                                                                                                                |
                                                                                                                                                                                                "v"
                                                                                                                                                                                                  %
                                                                                                                                                                                                  char
                                                                                                                                                                                                  |
                                                                                                                                                                                                  "w"
                                                                                                                                                                                                    %
                                                                                                                                                                                                    char
                                                                                                                                                                                                    |
                                                                                                                                                                                                    "x"
                                                                                                                                                                                                      %
                                                                                                                                                                                                      char
                                                                                                                                                                                                      |
                                                                                                                                                                                                      "y"
                                                                                                                                                                                                        %
                                                                                                                                                                                                        char
                                                                                                                                                                                                        |
                                                                                                                                                                                                        "z"
                                                                                                                                                                                                          %
                                                                                                                                                                                                          char
                                                                                                                                                                                                          |
                                                                                                                                                                                                          "{"
                                                                                                                                                                                                            %
                                                                                                                                                                                                            char
                                                                                                                                                                                                            |
                                                                                                                                                                                                            "|"
                                                                                                                                                                                                              %
                                                                                                                                                                                                              char
                                                                                                                                                                                                              |
                                                                                                                                                                                                              "}"
                                                                                                                                                                                                                %
                                                                                                                                                                                                                char
                                                                                                                                                                                                                |
                                                                                                                                                                                                                "~"
                                                                                                                                                                                                                  %
                                                                                                                                                                                                                  char
                  => check_printable_ascii (op_minus i 1)
                | _ => false
                end in
            if check_printable_ascii (op_minus (String.length v) 1) then
              __return (v, ctxt)
            else
              op_gtgteqquestion (error tt) fail)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.String_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.String_kind [])
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ v) =>
        op_gtgteqquestion
          (Lwt.__return
            (Gas.consume ctxt (Typecheck_costs.string (MBytes.length v))))
          (fun ctxt => __return (v, ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind [])
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Int _ v) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt (Typecheck_costs.z v)))
          (fun ctxt => __return ((Script_int.of_zint v), ctxt))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Int _ v) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt (Typecheck_costs.z v)))
          (fun ctxt =>
            let v := Script_int.of_zint v in
            if
              Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
                (Script_int.compare v Script_int.zero) 0 then
              __return ((Script_int.abs v), ctxt)
            else
              op_gtgteqquestion (error tt) fail)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.Int_kind [])
              (kind expr)))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.Int_kind [])
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Int _ v) =>
        op_gtgteqquestion
          (Lwt.__return
            (op_gtgtquestion (Gas.consume ctxt Typecheck_costs.tez)
              (fun ctxt =>
                Gas.consume ctxt Michelson_v1_gas.Cost_of.Legacy.z_to_int64)))
          (fun ctxt =>
            (* ❌ Try-with are not handled *)
            try
              match Tez.of_mutez (Z.to_int64 v) with
              | None => raise Exit
              | Some tez => __return (tez, ctxt)
              end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.Int_kind [])
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Int _ v) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt (Typecheck_costs.z v)))
          (fun ctxt => __return ((Script_timestamp.of_zint v), ctxt))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.String _ s) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.string_timestamp))
          (fun ctxt =>
            match Script_timestamp.of_string s with
            | Some v => __return (v, ctxt)
            | None => op_gtgteqquestion (error tt) fail
            end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.String_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Int_kind []))
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ bytes)
        =>
        op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Typecheck_costs.key))
          (fun ctxt =>
            match
              Data_encoding.Binary.of_bytes Signature.Public_key.encoding string
              with
            | Some k => __return (k, ctxt)
            | None => op_gtgteqquestion (error tt) fail
            end)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.String _ s) =>
        op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Typecheck_costs.key))
          (fun ctxt =>
            match Signature.Public_key.of_b58check_opt s with
            | Some k => __return (k, ctxt)
            | None => op_gtgteqquestion (error tt) fail
            end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.String_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind []))
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ bytes)
        =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.key_hash))
          (fun ctxt =>
            match
              Data_encoding.Binary.of_bytes Signature.Public_key_hash.encoding
                string with
            | Some k => __return (k, ctxt)
            | None => op_gtgteqquestion (error tt) fail
            end)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.String _ s) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.key_hash))
          (fun ctxt =>
            match Signature.Public_key_hash.of_b58check_opt s with
            | Some k => __return (k, ctxt)
            | None => op_gtgteqquestion (error tt) fail
            end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.String_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind []))
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ bytes)
        =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.signature))
          (fun ctxt =>
            match Data_encoding.Binary.of_bytes Signature.encoding string with
            | Some k => __return (k, ctxt)
            | None => op_gtgteqquestion (error tt) fail
            end)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.String _ s) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.signature))
          (fun ctxt =>
            match Signature.of_b58check_opt s with
            | Some s => __return (s, ctxt)
            | None => op_gtgteqquestion (error tt) fail
            end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.String_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind []))
              (kind expr)))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t _, _) =>
        (* ❌ Assert instruction is not handled. *)
        assert false
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ bytes)
        =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.chain_id))
          (fun ctxt =>
            match
              Data_encoding.Binary.of_bytes
                Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.encoding)
                string with
            | Some k => __return (k, ctxt)
            | None => op_gtgteqquestion (error tt) fail
            end)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.String _ s) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.chain_id))
          (fun ctxt =>
            match
              Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.of_b58check_opt)
                s with
            | Some s => __return (s, ctxt)
            | None => op_gtgteqquestion (error tt) fail
            end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.String_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind []))
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Bytes loc
            bytes) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.contract))
          (fun ctxt =>
            match
              Data_encoding.Binary.of_bytes
                (tup2 Contract.encoding Variable.string) string with
            | Some (c, entrypoint) =>
              if
                Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
                  (String.length entrypoint) 31 then
                fail
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Entrypoint_name_too_long
                    entrypoint)
              else
                op_gtgteqquestion
                  match entrypoint with
                  | "" % string => __return "default" % string
                  | "default" % string =>
                    fail
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                        loc)
                  | name => __return name
                  end (fun entrypoint => __return ((c, entrypoint), ctxt))
            | None => op_gtgteqquestion (error tt) fail
            end)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _,
          Tezos_protocol_environment_alpha__Environment.Micheline.String loc s)
        =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.contract))
          (fun ctxt =>
            op_gtgteqquestion
              match String.index_opt s "%" % char with
              | None => __return (s, "default" % string)
              | Some pos =>
                let len := op_minus (op_minus (String.length s) pos) 1 in
                let name := String.sub s (op_plus pos 1) len in
                if
                  Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
                    len 31 then
                  fail
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.Entrypoint_name_too_long
                      name)
                else
                  match ((String.sub s 0 pos), name) with
                  | (_, "default" % string) =>
                    traced
                      (fail
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                          loc))
                  | addr_and_name => __return addr_and_name
                  end
              end
              (fun function_parameter =>
                let '(addr, entrypoint) := function_parameter in
                op_gtgteqquestion (Lwt.__return (Contract.of_b58check addr))
                  (fun c => __return ((c, entrypoint), ctxt))))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.String_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind []))
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t ty _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Bytes loc
            bytes) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.contract))
          (fun ctxt =>
            match
              Data_encoding.Binary.of_bytes
                (tup2 Contract.encoding Variable.string) string with
            | Some (c, entrypoint) =>
              if
                Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
                  (String.length entrypoint) 31 then
                fail
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Entrypoint_name_too_long
                    entrypoint)
              else
                op_gtgteqquestion
                  match entrypoint with
                  | "" % string => __return "default" % string
                  | "default" % string =>
                    traced
                      (fail
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                          loc))
                  | name => __return name
                  end
                  (fun entrypoint =>
                    op_gtgteqquestion
                      (traced (parse_contract legacy ctxt loc ty c entrypoint))
                      (fun function_parameter =>
                        let '(ctxt, _) := function_parameter in
                        __return ((ty, (c, entrypoint)), ctxt)))
            | None => op_gtgteqquestion (error tt) fail
            end)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t ty _,
          Tezos_protocol_environment_alpha__Environment.Micheline.String loc s)
        =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.contract))
          (fun ctxt =>
            op_gtgteqquestion
              match String.index_opt s "%" % char with
              | None => __return (s, "default" % string)
              | Some pos =>
                let len := op_minus (op_minus (String.length s) pos) 1 in
                let name := String.sub s (op_plus pos 1) len in
                if
                  Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
                    len 31 then
                  fail
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.Entrypoint_name_too_long
                      name)
                else
                  match ((String.sub s 0 pos), name) with
                  | (_, "default" % string) =>
                    traced
                      (fail
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                          loc))
                  | addr_and_name => __return addr_and_name
                  end
              end
              (fun function_parameter =>
                let '(addr, entrypoint) := function_parameter in
                op_gtgteqquestion
                  (traced (Lwt.__return (Contract.of_b58check addr)))
                  (fun c =>
                    op_gtgteqquestion
                      (parse_contract legacy ctxt loc ty c entrypoint)
                      (fun function_parameter =>
                        let '(ctxt, _) := function_parameter in
                        __return ((ty, (c, entrypoint)), ctxt)))))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t _ _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.String_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind []))
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (ta, _, _) (tb, _, _) _
          _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Pair
            (cons va (cons vb [])) annot) =>
        op_gtgteqquestion
          (if legacy then
            __return tt
          else
            fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (Lwt.__return (Gas.consume ctxt Typecheck_costs.pair))
              (fun ctxt =>
                op_gtgteqquestion
                  (op_atat traced (parse_data type_logger ctxt legacy ta va))
                  (fun function_parameter =>
                    let '(va, ctxt) := function_parameter in
                    op_gtgteqquestion (parse_data type_logger ctxt legacy tb vb)
                      (fun function_parameter =>
                        let '(vb, ctxt) := function_parameter in
                        __return ((va, vb), ctxt)))))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t _ _ _ _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Pair l _) =>
        op_atat fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc Tezos_raw_protocol_alpha.Alpha_context.Script.D_Pair 2
            (List.length l))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t _ _ _ _, expr) =>
        traced
          (fail
            (unexpected expr []
              Tezos_raw_protocol_alpha.Script_tc_errors.Constant_namespace
              (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Pair [])))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tl, _) _ _ _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left (cons v [])
            annot) =>
        op_gtgteqquestion
          (if legacy then
            __return tt
          else
            fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (Lwt.__return (Gas.consume ctxt Typecheck_costs.union))
              (fun ctxt =>
                op_gtgteqquestion
                  (op_atat traced (parse_data type_logger ctxt legacy tl v))
                  (fun function_parameter =>
                    let '(v, ctxt) := function_parameter in
                    __return
                      ((Tezos_raw_protocol_alpha.Script_typed_ir.L v), ctxt))))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ _ _ _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left l _) =>
        op_atat fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left 1
            (List.length l))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ (tr, _) _ _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right (cons v [])
            annot) =>
        op_gtgteqquestion (fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (Lwt.__return (Gas.consume ctxt Typecheck_costs.union))
              (fun ctxt =>
                op_gtgteqquestion
                  (op_atat traced (parse_data type_logger ctxt legacy tr v))
                  (fun function_parameter =>
                    let '(v, ctxt) := function_parameter in
                    __return
                      ((Tezos_raw_protocol_alpha.Script_typed_ir.R v), ctxt))))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ _ _ _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right l _) =>
        op_atat fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right 1
            (List.length l))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ _ _ _, expr) =>
        traced
          (fail
            (unexpected expr []
              Tezos_raw_protocol_alpha.Script_tc_errors.Constant_namespace
              (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left
                (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right []))))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t ta tr _ty_name,
          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq _loc _)
            as script_instr) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Typecheck_costs.lambda))
          (fun ctxt =>
            op_atat traced
              (parse_returning type_logger Lambda ctxt legacy
                (ta,
                  (Some
                    (* ❌ Variants not supported *)
                    variant)) tr script_instr))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t _ _ _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t t _ _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Some (cons v [])
            annot) =>
        op_gtgteqquestion
          (if legacy then
            __return tt
          else
            fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (Lwt.__return (Gas.consume ctxt Typecheck_costs.some))
              (fun ctxt =>
                op_gtgteqquestion
                  (op_atat traced (parse_data type_logger ctxt legacy t v))
                  (fun function_parameter =>
                    let '(v, ctxt) := function_parameter in
                    __return ((Some v), ctxt))))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_Some l _) =>
        op_atat fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc Tezos_raw_protocol_alpha.Alpha_context.Script.D_Some 1
            (List.length l))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_None [] annot) =>
        op_gtgteqquestion
          (if legacy then
            __return tt
          else
            fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (Lwt.__return (Gas.consume ctxt Typecheck_costs.none))
              (fun ctxt => __return (None, ctxt)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.D_None l _) =>
        op_atat fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc Tezos_raw_protocol_alpha.Alpha_context.Script.D_None 0
            (List.length l))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ _, expr) =>
        traced
          (fail
            (unexpected expr []
              Tezos_raw_protocol_alpha.Script_tc_errors.Constant_namespace
              (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Some
                (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_None []))))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.List_t t _ty_name _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Seq _loc items)
        =>
        op_atat traced
          (fold_right_s
            (fun v =>
              fun function_parameter =>
                let '(rest, ctxt) := function_parameter in
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt Typecheck_costs.list_element))
                  (fun ctxt =>
                    op_gtgteqquestion (parse_data type_logger ctxt legacy t v)
                      (fun function_parameter =>
                        let '(v, ctxt) := function_parameter in
                        __return ((cons v rest), ctxt)))) items ([], ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.List_t _ _ _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t t _ty_name,
          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc vs)
            as expr) =>
        let length := List.length vs in
        op_gtgtpipequestion
          (op_atat traced
            (fold_left_s
              (fun function_parameter =>
                let '(last_value, set, ctxt) := function_parameter in
                fun v =>
                  op_gtgteqquestion
                    (Lwt.__return
                      (Gas.consume ctxt (Typecheck_costs.set_element length)))
                    (fun ctxt =>
                      op_gtgteqquestion
                        (parse_comparable_data type_logger ctxt t v)
                        (fun function_parameter =>
                          let '(v, ctxt) := function_parameter in
                          op_gtgteqquestion
                            match last_value with
                            | Some value =>
                              if
                                Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lteq)
                                  0 (compare_comparable t value v) then
                                if
                                  Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
                                    0 (compare_comparable t value v) then
                                  fail
                                    (Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_set_values
                                      loc (strip_locations expr))
                                else
                                  fail
                                    (Tezos_protocol_environment_alpha__Environment.Error_monad.Unordered_set_values
                                      loc (strip_locations expr))
                              else
                                return_unit
                            | None => return_unit
                            end
                            (fun function_parameter =>
                              let 'tt := function_parameter in
                              op_gtgteqquestion
                                (Lwt.__return
                                  (Gas.consume ctxt
                                    (Michelson_v1_gas.Cost_of.Legacy.set_update
                                      v false set)))
                                (fun ctxt =>
                                  __return
                                    ((Some v), (set_update v true set), ctxt))))))
              (None, (empty_set t), ctxt) vs))
          (fun function_parameter =>
            let '(_, set, ctxt) := function_parameter in
            (set, ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t _ _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t tk tv _ty_name _,
          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc vs)
            as expr) =>
        parse_items type_logger loc ctxt expr tk tv vs (fun x => x)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t _ _ _ _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
              (kind expr)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t tk tv _ty_name,
          (Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc vs)
            as expr) =>
        op_gtgtpipequestion
          (parse_items type_logger loc ctxt expr tk tv vs (fun x => Some x))
          (fun function_parameter =>
            let '(diff, ctxt) := function_parameter in
            ({| id := None; diff := diff; key_type := ty_of_comparable_ty tk;
              value_type := tv |}, ctxt))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t tk tv _ty_name,
          Tezos_protocol_environment_alpha__Environment.Micheline.Int loc id) =>
        op_gtgteqquestion (Big_map.__exists ctxt id)
          (fun function_parameter =>
            match function_parameter with
            | (_, None) =>
              traced
                (fail
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_big_map
                    loc id))
            | (ctxt, Some (btk, btv)) =>
              Lwt.__return
                (op_gtgtquestion (parse_comparable_ty ctxt (Micheline.root btk))
                  (fun function_parameter =>
                    let '(Ex_comparable_ty btk, ctxt) := function_parameter in
                    op_gtgtquestion
                      (parse_packable_ty ctxt legacy (Micheline.root btv))
                      (fun function_parameter =>
                        let '(Ex_ty btv, ctxt) := function_parameter in
                        op_gtgtquestion (comparable_ty_eq ctxt tk btk)
                          (fun function_parameter =>
                            let 'Eq := function_parameter in
                            op_gtgtquestion (ty_eq ctxt tv btv)
                              (fun function_parameter =>
                                let '(Eq, ctxt) := function_parameter in
                                ok
                                  ({| id := Some id; diff := empty_map tk;
                                    key_type := ty_of_comparable_ty tk;
                                    value_type := tv |}, ctxt))))))
            end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t _tk _tv _, expr) =>
        traced
          (fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              (location expr)
              (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Int_kind []))
              (kind expr)))
      end)

with parse_comparable_data {a : Type}
  (type_logger : option type_logger)
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a)
  (script_data : Tezos_raw_protocol_alpha.Alpha_context.Script.node)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (a * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  parse_data type_logger ctxt false (ty_of_comparable_ty ty) script_data

with parse_returning {arg ret : Type}
  (type_logger : option type_logger) (tc_context : tc_context)
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (legacy : bool)
  (function_parameter :
    Tezos_raw_protocol_alpha.Script_typed_ir.ty arg *
      option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot)
  : Tezos_raw_protocol_alpha.Script_typed_ir.ty ret ->
    Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Script_typed_ir.lambda arg ret *
            Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let '(arg, arg_annot) := function_parameter in
  fun ret =>
    fun script_instr =>
      op_gtgteqquestion
        (parse_instr type_logger tc_context ctxt legacy script_instr
          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t arg
            Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t arg_annot))
        (fun function_parameter =>
          match function_parameter with
          |
            (Typed
              ({|
                loc := loc;
                  aft :=
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                      ty
                      Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t
                      _) as stack_ty
                  |} as descr), ctxt) =>
            trace_eval
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion
                  (Lwt.__return (serialize_ty_for_error ctxt ret))
                  (fun function_parameter =>
                    let '(ret, ctxt) := function_parameter in
                    op_gtgtpipequestion
                      (serialize_stack_for_error ctxt stack_ty)
                      (fun function_parameter =>
                        let '(stack_ty, _ctxt) := function_parameter in
                        Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_return
                          loc stack_ty ret)))
              (op_gtgteqquestion (Lwt.__return (ty_eq ctxt ty ret))
                (fun function_parameter =>
                  let '(Eq, ctxt) := function_parameter in
                  op_gtgteqquestion
                    (Lwt.__return (merge_types legacy ctxt loc ty ret))
                    (fun function_parameter =>
                      let '(_ret, ctxt) := function_parameter in
                      __return
                        ((Tezos_raw_protocol_alpha.Script_typed_ir.Lam descr
                          script_instr), ctxt))))
          | (Typed {| loc := loc; aft := stack_ty |}, ctxt) =>
            op_gtgteqquestion (Lwt.__return (serialize_ty_for_error ctxt ret))
              (fun function_parameter =>
                let '(ret, ctxt) := function_parameter in
                op_gtgteqquestion (serialize_stack_for_error ctxt stack_ty)
                  (fun function_parameter =>
                    let '(stack_ty, _ctxt) := function_parameter in
                    fail
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_return
                        loc stack_ty ret)))
          | (Failed {| descr := descr |}, ctxt) =>
            __return
              ((Tezos_raw_protocol_alpha.Script_typed_ir.Lam
                (descr
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ret
                    Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t None))
                script_instr), ctxt)
          end)

with parse_int32
  (n :
    Tezos_protocol_environment_alpha__Environment.Micheline.node
      Tezos_raw_protocol_alpha.Alpha_context.Script.location
      Tezos_raw_protocol_alpha.Alpha_context.Script.prim)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z :=
  let error' (function_parameter : unit)
    : Tezos_protocol_environment_alpha__Environment.Error_monad.error :=
    let 'tt := function_parameter in
    Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_syntactic_constant
      (location n) (strip_locations n)
      (op_caret "a positive 32-bit integer (between 0 and " % string
        (op_caret (Int32.to_string Int32.max_int) ")" % string)) in
  match n with
  | Tezos_protocol_environment_alpha__Environment.Micheline.Int _ n' =>
    (* ❌ Try-with are not handled *)
    try
      (let n'' := Z.to_int n' in
      if
        op_andand
          (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lteq)
            0 n'')
          (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lteq)
            n'' (Int32.to_int Int32.max_int)) then
        ok n''
      else
        op_atat error (error' tt))
  | _ => op_atat error (error' tt)
  end

with parse_instr {bef : Type}
  (type_logger : option type_logger) (tc_context : tc_context)
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (legacy : bool)
  (script_instr : Tezos_raw_protocol_alpha.Alpha_context.Script.node)
  (stack_ty : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty bef)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (judgement bef * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let _check_item {B : Type}
    (check :
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) (loc :
    Tezos_raw_protocol_alpha.Alpha_context.Script.location) (name :
    Tezos_raw_protocol_alpha.Alpha_context.Script.prim) (n : Z) (m : Z)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
    op_atat
      (trace_eval
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtpipequestion (serialize_stack_for_error ctxt stack_ty)
            (fun function_parameter =>
              let '(stack_ty, _ctxt) := function_parameter in
              Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                loc name m stack_ty)))
      (op_atat
        (trace
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack_item
            n)) (Lwt.__return check)) in
  let check_item_ty {B C : Type}
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (exp :
    Tezos_raw_protocol_alpha.Script_typed_ir.ty B) (got :
    Tezos_raw_protocol_alpha.Script_typed_ir.ty C) (loc :
    Tezos_raw_protocol_alpha.Alpha_context.Script.location) (name :
    Tezos_raw_protocol_alpha.Alpha_context.Script.prim) (n : Z) (m : Z)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (eq B C * Tezos_raw_protocol_alpha.Script_typed_ir.ty B *
          Tezos_raw_protocol_alpha.Alpha_context.context)) :=
    op_atat
      (trace_eval
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtpipequestion (serialize_stack_for_error ctxt stack_ty)
            (fun function_parameter =>
              let '(stack_ty, _ctxt) := function_parameter in
              Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                loc name m stack_ty)))
      (op_atat
        (trace
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack_item
            n))
        (Lwt.__return
          (op_gtgtquestion (ty_eq ctxt exp got)
            (fun function_parameter =>
              let '(Eq, ctxt) := function_parameter in
              op_gtgtquestion (merge_types legacy ctxt loc exp got)
                (fun function_parameter =>
                  let '(ty, ctxt) := function_parameter in
                  ok (Eq, ty, ctxt)))))) in
  let check_item_comparable_ty {B C : Type}
    (exp : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty B) (got :
    Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty C) (loc :
    Tezos_raw_protocol_alpha.Alpha_context.Script.location) (name :
    Tezos_raw_protocol_alpha.Alpha_context.Script.prim) (n : Z) (m : Z)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (eq B C * Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty B)) :=
    op_atat
      (trace_eval
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgtpipequestion (serialize_stack_for_error ctxt stack_ty)
            (fun function_parameter =>
              let '(stack_ty, _ctxt) := function_parameter in
              Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                loc name m stack_ty)))
      (op_atat
        (trace
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack_item
            n))
        (Lwt.__return
          (op_gtgtquestion (comparable_ty_eq ctxt exp got)
            (fun function_parameter =>
              let 'Eq := function_parameter in
              op_gtgtquestion (merge_comparable_types legacy exp got)
                (fun ty => ok (Eq, ty)))))) in
  let log_stack {B C : Type}
    (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context) (loc : Z) (stack_ty
    : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty B) (aft :
    Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty C)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
    match (type_logger, script_instr) with
    |
      (None, _) |
        (Some _,
          Tezos_protocol_environment_alpha__Environment.Micheline.Seq (-1) _ |
            Tezos_protocol_environment_alpha__Environment.Micheline.Int _ _ |
            Tezos_protocol_environment_alpha__Environment.Micheline.String _ _ |
            Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ _)
      => return_unit
    |
      (Some log,
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim _ _ _ _ |
          Tezos_protocol_environment_alpha__Environment.Micheline.Seq _ _) =>
      let ctxt := Gas.set_unlimited ctxt in
      op_gtgteqquestion (unparse_stack ctxt stack_ty)
        (fun function_parameter =>
          let '(stack_ty, _) := function_parameter in
          op_gtgteqquestion (unparse_stack ctxt aft)
            (fun function_parameter =>
              let '(aft, _) := function_parameter in
              (* ❌ Sequences of instructions are not handled (operator ";") *)
              let _ := log loc stack_ty aft in
              return_unit))
    end in
  let outer_return := __return in
  let __return
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (judgement :
    judgement bef)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (judgement bef * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
    match judgement with
    | Typed {| loc := loc; aft := aft; instr := instr |} =>
      let maximum_type_size := Constants.michelson_maximum_type_size ctxt in
      let type_size :=
        type_size_of_stack_head aft (number_of_generated_growing_types instr) in
      if
        Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
          type_size maximum_type_size then
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Type_too_large
            loc type_size maximum_type_size)
      else
        __return (judgement, ctxt)
    | Failed _ => __return (judgement, ctxt)
    end in
  let typed {B : Type}
    (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context) (loc : Z) (instr :
    Tezos_raw_protocol_alpha.Script_typed_ir.instr bef B) (aft :
    Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty B)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (judgement bef * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
    op_gtgteqquestion (log_stack ctxt loc stack_ty aft)
      (fun function_parameter =>
        let 'tt := function_parameter in
        op_gtgteqquestion
          (op_atat Lwt.__return (Gas.consume ctxt (Typecheck_costs.instr instr)))
          (fun ctxt =>
            __return ctxt
              (Typed
                {| loc := loc; bef := stack_ty; aft := aft; instr := instr |})))
    in
  op_gtgteqquestion
    (op_atat Lwt.__return (Gas.consume ctxt Typecheck_costs.cycle))
    (fun ctxt =>
      match (script_instr, stack_ty) with
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DROP [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t _ rest _) =>
        op_gtgteqquestion (fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Drop rest)
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DROP (cons n [])
          result_annot, whole_stack) =>
        op_gtgteqquestion (Lwt.__return (parse_int32 n))
          (fun whole_n =>
            let fix make_proof_argument {tstk : Type}
              (n : Z) (stk :
              Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty tstk)
              : Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                  (dropn_proof_argument tstk)) :=
              match
                ((Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
                  n 0), stk) with
              | (true, rest) =>
                op_atat outer_return
                  (Dropn_proof_argument
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Rest, rest, rest))
              |
                (false,
                  Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v rest annot)
                =>
                op_gtgteqquestion (make_proof_argument (op_minus n 1) rest)
                  (fun function_parameter =>
                    let 'Dropn_proof_argument (n', stack_after_drops, aft') :=
                      function_parameter in
                    op_atat outer_return
                      (Dropn_proof_argument
                        ((Tezos_raw_protocol_alpha.Script_typed_ir.Prefix n'),
                          stack_after_drops,
                          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v
                            aft' annot))))
              | (_, _) =>
                op_gtgteqquestion (serialize_stack_for_error ctxt whole_stack)
                  (fun function_parameter =>
                    let '(whole_stack, _ctxt) := function_parameter in
                    fail
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                        loc Tezos_raw_protocol_alpha.Alpha_context.Script.I_DROP
                        whole_n whole_stack))
              end in
            op_gtgteqquestion (fail_unexpected_annot loc result_annot)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion (make_proof_argument whole_n whole_stack)
                  (fun function_parameter =>
                    let 'Dropn_proof_argument (n', stack_after_drops, _aft) :=
                      function_parameter in
                    typed ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Dropn whole_n n')
                      stack_after_drops)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DROP
          ((cons _ (cons _ _)) as l) _, _) =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc Tezos_raw_protocol_alpha.Alpha_context.Script.I_DROP 1
            (List.length l))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUP [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v rest stack_annot) =>
        op_gtgteqquestion (parse_var_annot loc (Some stack_annot) annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Dup
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v
                (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v rest
                  stack_annot) annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIG (cons n [])
          result_annot, stack) =>
        let fix make_proof_argument {tstk : Type}
          (n : Z) (stk : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty tstk)
          : Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (dig_proof_argument tstk)) :=
          match
            ((Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
              n 0), stk) with
          | (true, Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v rest annot)
            =>
            op_atat outer_return
              (Dig_proof_argument
                (Tezos_raw_protocol_alpha.Script_typed_ir.Rest, (v, annot), rest))
          |
            (false, Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v rest annot)
            =>
            op_gtgteqquestion (make_proof_argument (op_minus n 1) rest)
              (fun function_parameter =>
                let 'Dig_proof_argument (n', (x, xv), aft') :=
                  function_parameter in
                op_atat outer_return
                  (Dig_proof_argument
                    ((Tezos_raw_protocol_alpha.Script_typed_ir.Prefix n'),
                      (x, xv),
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v aft'
                        annot))))
          | (_, _) =>
            op_gtgteqquestion (serialize_stack_for_error ctxt stack)
              (fun function_parameter =>
                let '(whole_stack, _ctxt) := function_parameter in
                fail
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                    loc Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIG 1
                    whole_stack))
          end in
        op_gtgteqquestion (Lwt.__return (parse_int32 n))
          (fun n =>
            op_gtgteqquestion (fail_unexpected_annot loc result_annot)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion (make_proof_argument n stack)
                  (fun function_parameter =>
                    let 'Dig_proof_argument (n', (x, stack_annot), aft) :=
                      function_parameter in
                    typed ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Dig n n')
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t x aft
                        stack_annot))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIG
          (([] | cons _ (cons _ _)) as l) _, _) =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIG 1
            (List.length l))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUG (cons n [])
          result_annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t x whole_stack
            stack_annot) =>
        op_gtgteqquestion (Lwt.__return (parse_int32 n))
          (fun whole_n =>
            let fix make_proof_argument {tstk x : Type}
              (n : Z) (x : Tezos_raw_protocol_alpha.Script_typed_ir.ty x)
              (stack_annot :
              option Tezos_raw_protocol_alpha.Script_typed_ir.var_annot) (stk :
              Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty tstk)
              : Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                  (dug_proof_argument tstk x)) :=
              match
                ((Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
                  n 0), stk) with
              | (true, rest) =>
                op_atat outer_return
                  (Dug_proof_argument
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Rest, tt,
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t x rest
                        stack_annot)))
              |
                (false,
                  Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v rest annot)
                =>
                op_gtgteqquestion
                  (make_proof_argument (op_minus n 1) x stack_annot rest)
                  (fun function_parameter =>
                    let 'Dug_proof_argument (n', tt, aft') := function_parameter
                      in
                    op_atat outer_return
                      (Dug_proof_argument
                        ((Tezos_raw_protocol_alpha.Script_typed_ir.Prefix n'),
                          tt,
                          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v
                            aft' annot))))
              | (_, _) =>
                op_gtgteqquestion (serialize_stack_for_error ctxt whole_stack)
                  (fun function_parameter =>
                    let '(whole_stack, _ctxt) := function_parameter in
                    fail
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                        loc Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUG
                        whole_n whole_stack))
              end in
            op_gtgteqquestion (fail_unexpected_annot loc result_annot)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion
                  (make_proof_argument whole_n x stack_annot whole_stack)
                  (fun function_parameter =>
                    let 'Dug_proof_argument (n', tt, aft) := function_parameter
                      in
                    typed ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Dug whole_n n')
                      aft)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUG (cons _ [])
          result_annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t as stack) =>
        op_gtgteqquestion (fail_unexpected_annot loc result_annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion (serialize_stack_for_error ctxt stack)
              (fun function_parameter =>
                let '(stack, _ctxt) := function_parameter in
                fail
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                    loc Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUG 1
                    stack)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUG
          (([] | cons _ (cons _ _)) as l) _, _) =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUG 1
            (List.length l))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SWAP [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t w rest stack_annot)
            cur_top_annot) =>
        op_gtgteqquestion (fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Swap
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t w
                (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v rest
                  cur_top_annot) stack_annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_PUSH
          (cons t (cons d [])) annot, stack) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (parse_packable_ty ctxt legacy t))
              (fun function_parameter =>
                let '(Ex_ty t, ctxt) := function_parameter in
                op_gtgteqquestion (parse_data type_logger ctxt legacy t d)
                  (fun function_parameter =>
                    let '(v, ctxt) := function_parameter in
                    typed ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Const v)
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t stack
                        annot))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_UNIT [] annot, stack)
        =>
        op_gtgteqquestion (parse_var_type_annot loc annot)
          (fun function_parameter =>
            let '(annot, ty_name) := function_parameter in
            typed ctxt loc (Tezos_raw_protocol_alpha.Script_typed_ir.Const tt)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t ty_name) stack
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SOME [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t rest _) =>
        op_gtgteqquestion (parse_var_type_annot loc annot)
          (fun function_parameter =>
            let '(annot, ty_name) := function_parameter in
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Cons_some
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t t ty_name
                  (has_big_map t)) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NONE (cons t []) annot,
          stack) =>
        op_gtgteqquestion (op_atat Lwt.__return (parse_any_ty ctxt legacy t))
          (fun function_parameter =>
            let '(Ex_ty t, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_type_annot loc annot)
              (fun function_parameter =>
                let '(annot, ty_name) := function_parameter in
                typed ctxt loc
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Cons_none t)
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t t ty_name
                      (has_big_map t)) stack annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_NONE
          (cons bt (cons bf [])) annot,
          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t t _ _) rest
            option_annot) as bef) =>
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) bt)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (check_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) bf)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion (fail_unexpected_annot loc annot)
                  (fun function_parameter =>
                    let 'tt := function_parameter in
                    let annot :=
                      gen_access_annot option_annot None default_some_annot in
                    op_gtgteqquestion
                      (parse_instr type_logger tc_context ctxt legacy bt rest)
                      (fun function_parameter =>
                        let '(btr, ctxt) := function_parameter in
                        op_gtgteqquestion
                          (parse_instr type_logger tc_context ctxt legacy bf
                            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t
                              rest annot))
                          (fun function_parameter =>
                            let '(bfr, ctxt) := function_parameter in
                            let branch {B : Type}
                              (ibt :
                              Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                op_dollar57 B) (ibf :
                              Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                (op_dollar58 * op_dollar57) B)
                              : Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                (option op_dollar58 * op_dollar57) B :=
                              {| loc := loc; bef := bef; aft := aft ibt;
                                instr :=
                                  Tezos_raw_protocol_alpha.Script_typed_ir.If_none
                                    ibt ibf |} in
                            op_gtgteqquestion
                              (merge_branches legacy ctxt loc btr bfr
                                {| branch := branch |})
                              (fun function_parameter =>
                                let '(judgement, ctxt) := function_parameter in
                                __return ctxt judgement))))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_PAIR [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t a
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t b rest snd_annot)
            fst_annot) =>
        op_gtgteqquestion
          (parse_constr_annot loc (Some (var_to_field_annot fst_annot))
            (Some (var_to_field_annot snd_annot)) annot)
          (fun function_parameter =>
            let '(annot, ty_name, l_field, r_field) := function_parameter in
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Cons_pair
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                  (a, l_field, fst_annot) (b, r_field, snd_annot) ty_name
                  (op_pipepipe (has_big_map a) (has_big_map b))) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CAR [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
              (a, expected_field_annot, a_annot) _ _ _) rest pair_annot) =>
        op_gtgteqquestion
          (parse_destr_annot loc annot default_car_annot expected_field_annot
            pair_annot a_annot)
          (fun function_parameter =>
            let '(annot, field_annot) := function_parameter in
            op_gtgteqquestion
              (op_atat Lwt.__return
                (check_correct_field field_annot expected_field_annot))
              (fun function_parameter =>
                let 'tt := function_parameter in
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Car
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t a rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CDR [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t _
              (b, expected_field_annot, b_annot) _ _) rest pair_annot) =>
        op_gtgteqquestion
          (parse_destr_annot loc annot default_cdr_annot expected_field_annot
            pair_annot b_annot)
          (fun function_parameter =>
            let '(annot, field_annot) := function_parameter in
            op_gtgteqquestion
              (op_atat Lwt.__return
                (check_correct_field field_annot expected_field_annot))
              (fun function_parameter =>
                let 'tt := function_parameter in
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Cdr
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t b rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_LEFT (cons tr [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t tl rest stack_annot)
        =>
        op_gtgteqquestion (op_atat Lwt.__return (parse_any_ty ctxt legacy tr))
          (fun function_parameter =>
            let '(Ex_ty tr, ctxt) := function_parameter in
            op_gtgteqquestion
              (parse_constr_annot loc (Some (var_to_field_annot stack_annot))
                None annot)
              (fun function_parameter =>
                let '(annot, tname, l_field, r_field) := function_parameter in
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Left
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t
                      (tl, l_field) (tr, r_field) tname
                      (op_pipepipe (has_big_map tl) (has_big_map tr))) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_RIGHT (cons tl [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t tr rest stack_annot)
        =>
        op_gtgteqquestion (op_atat Lwt.__return (parse_any_ty ctxt legacy tl))
          (fun function_parameter =>
            let '(Ex_ty tl, ctxt) := function_parameter in
            op_gtgteqquestion
              (parse_constr_annot loc None
                (Some (var_to_field_annot stack_annot)) annot)
              (fun function_parameter =>
                let '(annot, tname, l_field, r_field) := function_parameter in
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Right
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t
                      (tl, l_field) (tr, r_field) tname
                      (op_pipepipe (has_big_map tl) (has_big_map tr))) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_LEFT
          (cons bt (cons bf [])) annot,
          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tl, l_field)
              (tr, r_field) _ _) rest union_annot) as bef) =>
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) bt)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (check_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) bf)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion (fail_unexpected_annot loc annot)
                  (fun function_parameter =>
                    let 'tt := function_parameter in
                    let left_annot :=
                      gen_access_annot union_annot (Some default_left_annot)
                        l_field in
                    let right_annot :=
                      gen_access_annot union_annot (Some default_right_annot)
                        r_field in
                    op_gtgteqquestion
                      (parse_instr type_logger tc_context ctxt legacy bt
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t tl rest
                          left_annot))
                      (fun function_parameter =>
                        let '(btr, ctxt) := function_parameter in
                        op_gtgteqquestion
                          (parse_instr type_logger tc_context ctxt legacy bf
                            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t tr
                              rest right_annot))
                          (fun function_parameter =>
                            let '(bfr, ctxt) := function_parameter in
                            let branch {B : Type}
                              (ibt :
                              Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                (op_dollar77 * op_dollar76) B) (ibf :
                              Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                (op_dollar78 * op_dollar76) B)
                              : Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                (Tezos_raw_protocol_alpha.Script_typed_ir.union
                                  op_dollar77 op_dollar78 * op_dollar76) B :=
                              {| loc := loc; bef := bef; aft := aft ibt;
                                instr :=
                                  Tezos_raw_protocol_alpha.Script_typed_ir.If_left
                                    ibt ibf |} in
                            op_gtgteqquestion
                              (merge_branches legacy ctxt loc btr bfr
                                {| branch := branch |})
                              (fun function_parameter =>
                                let '(judgement, ctxt) := function_parameter in
                                __return ctxt judgement))))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NIL (cons t []) annot,
          stack) =>
        op_gtgteqquestion (op_atat Lwt.__return (parse_any_ty ctxt legacy t))
          (fun function_parameter =>
            let '(Ex_ty t, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_type_annot loc annot)
              (fun function_parameter =>
                let '(annot, ty_name) := function_parameter in
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Nil
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.List_t t ty_name
                      (has_big_map t)) stack annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONS [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t tv
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.List_t t ty_name
                has_big_map) rest _) _) =>
        op_gtgteqquestion
          (check_item_ty ctxt tv t loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONS 1 2)
          (fun function_parameter =>
            let '(Eq, t, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_annot loc None annot)
              (fun annot =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Cons_list
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.List_t t ty_name
                      has_big_map) rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_CONS
          (cons bt (cons bf [])) annot,
          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.List_t t ty_name
              has_big_map) rest list_annot) as bef) =>
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) bt)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (check_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) bf)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion (fail_unexpected_annot loc annot)
                  (fun function_parameter =>
                    let 'tt := function_parameter in
                    let hd_annot :=
                      gen_access_annot list_annot None default_hd_annot in
                    let tl_annot :=
                      gen_access_annot list_annot None default_tl_annot in
                    op_gtgteqquestion
                      (parse_instr type_logger tc_context ctxt legacy bt
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t
                          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                            (Tezos_raw_protocol_alpha.Script_typed_ir.List_t t
                              ty_name has_big_map) rest tl_annot) hd_annot))
                      (fun function_parameter =>
                        let '(btr, ctxt) := function_parameter in
                        op_gtgteqquestion
                          (parse_instr type_logger tc_context ctxt legacy bf
                            rest)
                          (fun function_parameter =>
                            let '(bfr, ctxt) := function_parameter in
                            let branch {B : Type}
                              (ibt :
                              Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                (op_dollar86 * (list op_dollar86 * op_dollar85))
                                B) (ibf :
                              Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                op_dollar85 B)
                              : Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                (list op_dollar86 * op_dollar85) B :=
                              {| loc := loc; bef := bef; aft := aft ibt;
                                instr :=
                                  Tezos_raw_protocol_alpha.Script_typed_ir.If_cons
                                    ibt ibf |} in
                            op_gtgteqquestion
                              (merge_branches legacy ctxt loc btr bfr
                                {| branch := branch |})
                              (fun function_parameter =>
                                let '(judgement, ctxt) := function_parameter in
                                __return ctxt judgement))))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SIZE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.List_t _ _ _) rest _) =>
        op_gtgteqquestion (parse_var_type_annot loc annot)
          (fun function_parameter =>
            let '(annot, tname) := function_parameter in
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.List_size
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MAP (cons body [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.List_t elt _ _)
            starting_rest list_annot) =>
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) body)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion (parse_var_type_annot loc annot)
              (fun function_parameter =>
                let '(ret_annot, list_ty_name) := function_parameter in
                let elt_annot :=
                  gen_access_annot list_annot None default_elt_annot in
                op_gtgteqquestion
                  (parse_instr type_logger tc_context ctxt legacy body
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t elt
                      starting_rest elt_annot))
                  (fun function_parameter =>
                    let '(judgement, ctxt) := function_parameter in
                    match judgement with
                    |
                      Typed
                        ({|
                          aft := Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ret rest _
                            |} as ibody) =>
                      let invalid_map_body (function_parameter : unit)
                        : Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                            Tezos_protocol_environment_alpha__Environment.Error_monad.error) :=
                        let 'tt := function_parameter in
                        op_gtgtpipequestion
                          (serialize_stack_for_error ctxt (aft ibody))
                          (fun function_parameter =>
                            let '(aft, _ctxt) := function_parameter in
                            Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_map_body
                              loc aft) in
                      trace_eval invalid_map_body
                        (op_gtgteqquestion
                          (op_atat Lwt.__return
                            (stack_ty_eq ctxt 1 rest starting_rest))
                          (fun function_parameter =>
                            let '(Eq, ctxt) := function_parameter in
                            op_gtgteqquestion
                              (op_atat Lwt.__return
                                (merge_stacks legacy loc ctxt rest starting_rest))
                              (fun function_parameter =>
                                let '(rest, ctxt) := function_parameter in
                                typed ctxt loc
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.List_map
                                    ibody)
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                    (Tezos_raw_protocol_alpha.Script_typed_ir.List_t
                                      ret list_ty_name (has_big_map ret)) rest
                                    ret_annot))))
                    | Typed {| aft := aft |} =>
                      op_gtgteqquestion (serialize_stack_for_error ctxt aft)
                        (fun function_parameter =>
                          let '(aft, _ctxt) := function_parameter in
                          fail
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_map_body
                              loc aft))
                    | Failed _ =>
                      fail
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_map_block_fail
                          loc)
                    end)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ITER (cons body [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.List_t elt _ _) rest
            list_annot) =>
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) body)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion (fail_unexpected_annot loc annot)
              (fun function_parameter =>
                let 'tt := function_parameter in
                let elt_annot :=
                  gen_access_annot list_annot None default_elt_annot in
                op_gtgteqquestion
                  (parse_instr type_logger tc_context ctxt legacy body
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t elt rest
                      elt_annot))
                  (fun function_parameter =>
                    let '(judgement, ctxt) := function_parameter in
                    match judgement with
                    | Typed ({| aft := aft |} as ibody) =>
                      let invalid_iter_body (function_parameter : unit)
                        : Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                            Tezos_protocol_environment_alpha__Environment.Error_monad.error) :=
                        let 'tt := function_parameter in
                        op_gtgteqquestion
                          (serialize_stack_for_error ctxt (aft ibody))
                          (fun function_parameter =>
                            let '(aft, ctxt) := function_parameter in
                            op_gtgtpipequestion
                              (serialize_stack_for_error ctxt rest)
                              (fun function_parameter =>
                                let '(rest, _ctxt) := function_parameter in
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_iter_body
                                  loc rest aft)) in
                      trace_eval invalid_iter_body
                        (op_gtgteqquestion
                          (op_atat Lwt.__return (stack_ty_eq ctxt 1 aft rest))
                          (fun function_parameter =>
                            let '(Eq, ctxt) := function_parameter in
                            op_gtgteqquestion
                              (op_atat Lwt.__return
                                (merge_stacks legacy loc ctxt aft rest))
                              (fun function_parameter =>
                                let '(rest, ctxt) := function_parameter in
                                typed ctxt loc
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.List_iter
                                    ibody) rest)))
                    | Failed {| descr := descr |} =>
                      typed ctxt loc
                        (Tezos_raw_protocol_alpha.Script_typed_ir.List_iter
                          (descr rest)) rest
                    end)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EMPTY_SET (cons t [])
          annot, rest) =>
        op_gtgteqquestion (op_atat Lwt.__return (parse_comparable_ty ctxt t))
          (fun function_parameter =>
            let '(Ex_comparable_ty t, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_type_annot loc annot)
              (fun function_parameter =>
                let '(annot, tname) := function_parameter in
                typed ctxt loc
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Empty_set t)
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t t tname)
                    rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ITER (cons body [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t comp_elt _) rest
            set_annot) =>
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) body)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion (fail_unexpected_annot loc annot)
              (fun function_parameter =>
                let 'tt := function_parameter in
                let elt_annot :=
                  gen_access_annot set_annot None default_elt_annot in
                let elt := ty_of_comparable_ty comp_elt in
                op_gtgteqquestion
                  (parse_instr type_logger tc_context ctxt legacy body
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t elt rest
                      elt_annot))
                  (fun function_parameter =>
                    let '(judgement, ctxt) := function_parameter in
                    match judgement with
                    | Typed ({| aft := aft |} as ibody) =>
                      let invalid_iter_body (function_parameter : unit)
                        : Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                            Tezos_protocol_environment_alpha__Environment.Error_monad.error) :=
                        let 'tt := function_parameter in
                        op_gtgteqquestion
                          (serialize_stack_for_error ctxt (aft ibody))
                          (fun function_parameter =>
                            let '(aft, ctxt) := function_parameter in
                            op_gtgtpipequestion
                              (serialize_stack_for_error ctxt rest)
                              (fun function_parameter =>
                                let '(rest, _ctxt) := function_parameter in
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_iter_body
                                  loc rest aft)) in
                      trace_eval invalid_iter_body
                        (op_gtgteqquestion
                          (op_atat Lwt.__return (stack_ty_eq ctxt 1 aft rest))
                          (fun function_parameter =>
                            let '(Eq, ctxt) := function_parameter in
                            op_gtgteqquestion
                              (op_atat Lwt.__return
                                (merge_stacks legacy loc ctxt aft rest))
                              (fun function_parameter =>
                                let '(rest, ctxt) := function_parameter in
                                typed ctxt loc
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Set_iter
                                    ibody) rest)))
                    | Failed {| descr := descr |} =>
                      typed ctxt loc
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Set_iter
                          (descr rest)) rest
                    end)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MEM [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t elt _) rest _) _)
        =>
        let elt := ty_of_comparable_ty elt in
        op_gtgteqquestion (parse_var_type_annot loc annot)
          (fun function_parameter =>
            let '(annot, tname) := function_parameter in
            op_gtgteqquestion
              (check_item_ty ctxt elt v loc
                Tezos_raw_protocol_alpha.Alpha_context.Script.I_MEM 1 2)
              (fun function_parameter =>
                let '(Eq, _, ctxt) := function_parameter in
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Set_mem
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t elt tname) rest
                set_annot) _) _) =>
        match comparable_ty_of_ty v with
        | None =>
          op_gtgteqquestion (unparse_ty ctxt v)
            (fun function_parameter =>
              let '(v, _ctxt) := function_parameter in
              fail
                (Tezos_protocol_environment_alpha__Environment.Error_monad.Comparable_type_expected
                  loc (Micheline.strip_locations v)))
        | Some v =>
          op_gtgteqquestion (parse_var_annot loc (Some set_annot) annot)
            (fun annot =>
              op_gtgteqquestion
                (check_item_comparable_ty elt v loc
                  Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE 1 3)
                (fun function_parameter =>
                  let '(Eq, elt) := function_parameter in
                  typed ctxt loc
                    Tezos_raw_protocol_alpha.Script_typed_ir.Set_update
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t elt tname)
                      rest annot)))
        end
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SIZE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t _ _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Set_size
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t None) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EMPTY_MAP
          (cons tk (cons tv [])) annot, stack) =>
        op_gtgteqquestion (op_atat Lwt.__return (parse_comparable_ty ctxt tk))
          (fun function_parameter =>
            let '(Ex_comparable_ty tk, ctxt) := function_parameter in
            op_gtgteqquestion
              (op_atat Lwt.__return (parse_any_ty ctxt legacy tv))
              (fun function_parameter =>
                let '(Ex_ty tv, ctxt) := function_parameter in
                op_gtgteqquestion (parse_var_type_annot loc annot)
                  (fun function_parameter =>
                    let '(annot, ty_name) := function_parameter in
                    typed ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Empty_map tk tv)
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t tk tv
                          ty_name (has_big_map tv)) stack annot))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MAP (cons body [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t ck elt _ _)
            starting_rest _map_annot) =>
        let k := ty_of_comparable_ty ck in
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) body)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion (parse_var_type_annot loc annot)
              (fun function_parameter =>
                let '(ret_annot, ty_name) := function_parameter in
                let k_name := field_to_var_annot default_key_annot in
                let e_name := field_to_var_annot default_elt_annot in
                op_gtgteqquestion
                  (parse_instr type_logger tc_context ctxt legacy body
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                        (k, None, k_name) (elt, None, e_name) None
                        (has_big_map elt)) starting_rest None))
                  (fun function_parameter =>
                    let '(judgement, ctxt) := function_parameter in
                    match judgement with
                    |
                      Typed
                        ({|
                          aft := Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ret rest _
                            |} as ibody) =>
                      let invalid_map_body (function_parameter : unit)
                        : Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                            Tezos_protocol_environment_alpha__Environment.Error_monad.error) :=
                        let 'tt := function_parameter in
                        op_gtgtpipequestion
                          (serialize_stack_for_error ctxt (aft ibody))
                          (fun function_parameter =>
                            let '(aft, _ctxt) := function_parameter in
                            Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_map_body
                              loc aft) in
                      trace_eval invalid_map_body
                        (op_gtgteqquestion
                          (op_atat Lwt.__return
                            (stack_ty_eq ctxt 1 rest starting_rest))
                          (fun function_parameter =>
                            let '(Eq, ctxt) := function_parameter in
                            op_gtgteqquestion
                              (op_atat Lwt.__return
                                (merge_stacks legacy loc ctxt rest starting_rest))
                              (fun function_parameter =>
                                let '(rest, ctxt) := function_parameter in
                                typed ctxt loc
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Map_map
                                    ibody)
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                    (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t
                                      ck ret ty_name (has_big_map ret)) rest
                                    ret_annot))))
                    | Typed {| aft := aft |} =>
                      op_gtgteqquestion (serialize_stack_for_error ctxt aft)
                        (fun function_parameter =>
                          let '(aft, _ctxt) := function_parameter in
                          fail
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_map_body
                              loc aft))
                    | Failed _ =>
                      fail
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_map_block_fail
                          loc)
                    end)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ITER (cons body [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t comp_elt element_ty
              _ _) rest _map_annot) =>
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) body)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion (fail_unexpected_annot loc annot)
              (fun function_parameter =>
                let 'tt := function_parameter in
                let k_name := field_to_var_annot default_key_annot in
                let e_name := field_to_var_annot default_elt_annot in
                let key := ty_of_comparable_ty comp_elt in
                op_gtgteqquestion
                  (parse_instr type_logger tc_context ctxt legacy body
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                        (key, None, k_name) (element_ty, None, e_name) None
                        (has_big_map element_ty)) rest None))
                  (fun function_parameter =>
                    let '(judgement, ctxt) := function_parameter in
                    match judgement with
                    | Typed ({| aft := aft |} as ibody) =>
                      let invalid_iter_body (function_parameter : unit)
                        : Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                            Tezos_protocol_environment_alpha__Environment.Error_monad.error) :=
                        let 'tt := function_parameter in
                        op_gtgteqquestion
                          (serialize_stack_for_error ctxt (aft ibody))
                          (fun function_parameter =>
                            let '(aft, ctxt) := function_parameter in
                            op_gtgtpipequestion
                              (serialize_stack_for_error ctxt rest)
                              (fun function_parameter =>
                                let '(rest, _ctxt) := function_parameter in
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_iter_body
                                  loc rest aft)) in
                      trace_eval invalid_iter_body
                        (op_gtgteqquestion
                          (op_atat Lwt.__return (stack_ty_eq ctxt 1 aft rest))
                          (fun function_parameter =>
                            let '(Eq, ctxt) := function_parameter in
                            op_gtgteqquestion
                              (op_atat Lwt.__return
                                (merge_stacks legacy loc ctxt aft rest))
                              (fun function_parameter =>
                                let '(rest, ctxt) := function_parameter in
                                typed ctxt loc
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Map_iter
                                    ibody) rest)))
                    | Failed {| descr := descr |} =>
                      typed ctxt loc
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Map_iter
                          (descr rest)) rest
                    end)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MEM [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t vk
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t ck _ _ _) rest _)
            _) =>
        let k := ty_of_comparable_ty ck in
        op_gtgteqquestion
          (check_item_ty ctxt vk k loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_MEM 1 2)
          (fun function_parameter =>
            let '(Eq, _, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_annot loc None annot)
              (fun annot =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Map_mem
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t None) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_GET [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t vk
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t ck elt _
                has_big_map) rest _) _) =>
        let k := ty_of_comparable_ty ck in
        op_gtgteqquestion
          (check_item_ty ctxt vk k loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GET 1 2)
          (fun function_parameter =>
            let '(Eq, _, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_annot loc None annot)
              (fun annot =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Map_get
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t elt None
                      has_big_map) rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t vk
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t vv _ _)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t ck v map_name
                  has_big_map) rest map_annot) _) _) =>
        let k := ty_of_comparable_ty ck in
        op_gtgteqquestion
          (check_item_ty ctxt vk k loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE 1 3)
          (fun function_parameter =>
            let '(Eq, _, ctxt) := function_parameter in
            op_gtgteqquestion
              (check_item_ty ctxt vv v loc
                Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE 2 3)
              (fun function_parameter =>
                let '(Eq, v, ctxt) := function_parameter in
                op_gtgteqquestion (parse_var_annot loc (Some map_annot) annot)
                  (fun annot =>
                    typed ctxt loc
                      Tezos_raw_protocol_alpha.Script_typed_ir.Map_update
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t ck v
                          map_name has_big_map) rest annot))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SIZE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t _ _ _ _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Map_size
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t None) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EMPTY_BIG_MAP
          (cons tk (cons tv [])) annot, stack) =>
        op_gtgteqquestion (op_atat Lwt.__return (parse_comparable_ty ctxt tk))
          (fun function_parameter =>
            let '(Ex_comparable_ty tk, ctxt) := function_parameter in
            op_gtgteqquestion
              (op_atat Lwt.__return (parse_packable_ty ctxt legacy tv))
              (fun function_parameter =>
                let '(Ex_ty tv, ctxt) := function_parameter in
                op_gtgteqquestion (parse_var_type_annot loc annot)
                  (fun function_parameter =>
                    let '(annot, ty_name) := function_parameter in
                    typed ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Empty_big_map tk
                        tv)
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t tk
                          tv ty_name) stack annot))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MEM [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t set_key
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t map_key _ _)
              rest _) _) =>
        let k := ty_of_comparable_ty map_key in
        op_gtgteqquestion
          (check_item_ty ctxt set_key k loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_MEM 1 2)
          (fun function_parameter =>
            let '(Eq, _, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_annot loc None annot)
              (fun annot =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_mem
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t None) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_GET [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t vk
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t ck elt _) rest
              _) _) =>
        let k := ty_of_comparable_ty ck in
        op_gtgteqquestion
          (check_item_ty ctxt vk k loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GET 1 2)
          (fun function_parameter =>
            let '(Eq, _, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_annot loc None annot)
              (fun annot =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_get
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t elt None
                      (has_big_map elt)) rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t set_key
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t set_value _ _)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t map_key
                  map_value map_name) rest map_annot) _) _) =>
        let k := ty_of_comparable_ty map_key in
        op_gtgteqquestion
          (check_item_ty ctxt set_key k loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE 1 3)
          (fun function_parameter =>
            let '(Eq, _, ctxt) := function_parameter in
            op_gtgteqquestion
              (check_item_ty ctxt set_value map_value loc
                Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE 2 3)
              (fun function_parameter =>
                let '(Eq, map_value, ctxt) := function_parameter in
                op_gtgteqquestion (parse_var_annot loc (Some map_annot) annot)
                  (fun annot =>
                    typed ctxt loc
                      Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_update
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t
                          map_key map_value map_name) rest annot))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc [],
          stack) =>
        typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Nop stack
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc
          (cons single []), stack) =>
        op_gtgteqquestion
          (parse_instr type_logger tc_context ctxt legacy single stack)
          (fun function_parameter =>
            let '(judgement, ctxt) := function_parameter in
            match judgement with
            | Typed ({| aft := aft |} as instr) =>
              let nop :=
                {| loc := loc; bef := aft; aft := aft;
                  instr := Tezos_raw_protocol_alpha.Script_typed_ir.Nop |} in
              typed ctxt loc
                (Tezos_raw_protocol_alpha.Script_typed_ir.Seq instr nop) aft
            | Failed {| descr := descr |} =>
              let descr {B : Type}
                (aft : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty B)
                : Tezos_raw_protocol_alpha.Script_typed_ir.descr bef B :=
                let nop :=
                  {| loc := loc; bef := aft; aft := aft;
                    instr := Tezos_raw_protocol_alpha.Script_typed_ir.Nop |} in
                let descr := descr aft in
                (* ❌ Record substitution not handled *)
                record_substitution in
              __return ctxt (Failed {| descr := descr |})
            end)
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc
          (cons hd tl), stack) =>
        op_gtgteqquestion
          (parse_instr type_logger tc_context ctxt legacy hd stack)
          (fun function_parameter =>
            let '(judgement, ctxt) := function_parameter in
            match judgement with
            | Failed _ =>
              fail
                (Tezos_protocol_environment_alpha__Environment.Error_monad.Fail_not_in_tail_position
                  (Micheline.location hd))
            | Typed ({| aft := middle |} as ihd) =>
              op_gtgteqquestion
                (parse_instr type_logger tc_context ctxt legacy
                  (Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                    (-1) tl) middle)
                (fun function_parameter =>
                  let '(judgement, ctxt) := function_parameter in
                  match judgement with
                  | Failed {| descr := descr |} =>
                    let descr {B : Type}
                      (ret :
                      Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty B)
                      : Tezos_raw_protocol_alpha.Script_typed_ir.descr bef B :=
                      {| loc := loc; bef := stack; aft := ret;
                        instr :=
                          Tezos_raw_protocol_alpha.Script_typed_ir.Seq ihd
                            (descr ret) |} in
                    __return ctxt (Failed {| descr := descr |})
                  | Typed itl =>
                    typed ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Seq ihd itl)
                      (aft itl)
                  end)
            end)
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF
          (cons bt (cons bf [])) annot,
          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _) rest _) as bef)
        =>
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) bt)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (check_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) bf)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion (fail_unexpected_annot loc annot)
                  (fun function_parameter =>
                    let 'tt := function_parameter in
                    op_gtgteqquestion
                      (parse_instr type_logger tc_context ctxt legacy bt rest)
                      (fun function_parameter =>
                        let '(btr, ctxt) := function_parameter in
                        op_gtgteqquestion
                          (parse_instr type_logger tc_context ctxt legacy bf
                            rest)
                          (fun function_parameter =>
                            let '(bfr, ctxt) := function_parameter in
                            let branch {B : Type}
                              (ibt :
                              Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                op_dollar169 B) (ibf :
                              Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                op_dollar169 B)
                              : Tezos_raw_protocol_alpha.Script_typed_ir.descr
                                (bool * op_dollar169) B :=
                              {| loc := loc; bef := bef; aft := aft ibt;
                                instr :=
                                  Tezos_raw_protocol_alpha.Script_typed_ir.If
                                    ibt ibf |} in
                            op_gtgteqquestion
                              (merge_branches legacy ctxt loc btr bfr
                                {| branch := branch |})
                              (fun function_parameter =>
                                let '(judgement, ctxt) := function_parameter in
                                __return ctxt judgement))))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_LOOP (cons body [])
          annot,
          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _) rest
            _stack_annot) as stack) =>
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) body)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion (fail_unexpected_annot loc annot)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion
                  (parse_instr type_logger tc_context ctxt legacy body rest)
                  (fun function_parameter =>
                    let '(judgement, ctxt) := function_parameter in
                    match judgement with
                    | Typed ibody =>
                      let unmatched_branches (function_parameter : unit)
                        : Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                            Tezos_protocol_environment_alpha__Environment.Error_monad.error) :=
                        let 'tt := function_parameter in
                        op_gtgteqquestion
                          (serialize_stack_for_error ctxt (aft ibody))
                          (fun function_parameter =>
                            let '(aft, ctxt) := function_parameter in
                            op_gtgtpipequestion
                              (serialize_stack_for_error ctxt stack)
                              (fun function_parameter =>
                                let '(stack, _ctxt) := function_parameter in
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Unmatched_branches
                                  loc aft stack)) in
                      trace_eval unmatched_branches
                        (op_gtgteqquestion
                          (op_atat Lwt.__return
                            (stack_ty_eq ctxt 1 (aft ibody) stack))
                          (fun function_parameter =>
                            let '(Eq, ctxt) := function_parameter in
                            op_gtgteqquestion
                              (op_atat Lwt.__return
                                (merge_stacks legacy loc ctxt (aft ibody) stack))
                              (fun function_parameter =>
                                let '(_stack, ctxt) := function_parameter in
                                typed ctxt loc
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Loop
                                    ibody) rest)))
                    | Failed {| descr := descr |} =>
                      let ibody := descr stack in
                      typed ctxt loc
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Loop ibody)
                        rest
                    end)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_LOOP_LEFT
          (cons body []) annot,
          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tl, l_field)
              (tr, _) _ _) rest union_annot) as stack) =>
        op_gtgteqquestion
          (check_kind
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind []) body)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion (parse_var_annot loc None annot)
              (fun annot =>
                let l_annot :=
                  gen_access_annot union_annot (Some default_left_annot) l_field
                  in
                op_gtgteqquestion
                  (parse_instr type_logger tc_context ctxt legacy body
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t tl rest
                      l_annot))
                  (fun function_parameter =>
                    let '(judgement, ctxt) := function_parameter in
                    match judgement with
                    | Typed ibody =>
                      let unmatched_branches (function_parameter : unit)
                        : Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                            Tezos_protocol_environment_alpha__Environment.Error_monad.error) :=
                        let 'tt := function_parameter in
                        op_gtgteqquestion
                          (serialize_stack_for_error ctxt (aft ibody))
                          (fun function_parameter =>
                            let '(aft, ctxt) := function_parameter in
                            op_gtgtpipequestion
                              (serialize_stack_for_error ctxt stack)
                              (fun function_parameter =>
                                let '(stack, _ctxt) := function_parameter in
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Unmatched_branches
                                  loc aft stack)) in
                      trace_eval unmatched_branches
                        (op_gtgteqquestion
                          (op_atat Lwt.__return
                            (stack_ty_eq ctxt 1 (aft ibody) stack))
                          (fun function_parameter =>
                            let '(Eq, ctxt) := function_parameter in
                            op_gtgteqquestion
                              (op_atat Lwt.__return
                                (merge_stacks legacy loc ctxt (aft ibody) stack))
                              (fun function_parameter =>
                                let '(_stack, ctxt) := function_parameter in
                                typed ctxt loc
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Loop_left
                                    ibody)
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                    tr rest annot))))
                    | Failed {| descr := descr |} =>
                      let ibody := descr stack in
                      typed ctxt loc
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Loop_left
                          ibody)
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t tr rest
                          annot)
                    end)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_LAMBDA
          (cons arg (cons ret (cons code []))) annot, stack) =>
        op_gtgteqquestion (op_atat Lwt.__return (parse_any_ty ctxt legacy arg))
          (fun function_parameter =>
            let '(Ex_ty arg, ctxt) := function_parameter in
            op_gtgteqquestion
              (op_atat Lwt.__return (parse_any_ty ctxt legacy ret))
              (fun function_parameter =>
                let '(Ex_ty ret, ctxt) := function_parameter in
                op_gtgteqquestion
                  (check_kind
                    (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
                    code)
                  (fun function_parameter =>
                    let 'tt := function_parameter in
                    op_gtgteqquestion (parse_var_annot loc None annot)
                      (fun annot =>
                        op_gtgteqquestion
                          (parse_returning type_logger Lambda ctxt legacy
                            (arg, default_arg_annot) ret code)
                          (fun function_parameter =>
                            let '(lambda, ctxt) := function_parameter in
                            typed ctxt loc
                              (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda
                                lambda)
                              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t
                                  arg ret None) stack annot))))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EXEC [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t arg
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t param ret _)
              rest _) _) =>
        op_gtgteqquestion
          (check_item_ty ctxt arg param loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EXEC 1 2)
          (fun function_parameter =>
            let '(Eq, _, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_annot loc None annot)
              (fun annot =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Exec
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ret rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_APPLY [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t capture
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                  (capture_ty, _, _) (arg_ty, _, _) lam_annot _) ret _) rest _)
            _) =>
        op_gtgteqquestion
          (op_atat Lwt.__return (check_packable false loc capture_ty))
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (check_item_ty ctxt capture capture_ty loc
                Tezos_raw_protocol_alpha.Alpha_context.Script.I_APPLY 1 2)
              (fun function_parameter =>
                let '(Eq, capture_ty, ctxt) := function_parameter in
                op_gtgteqquestion (parse_var_annot loc None annot)
                  (fun annot =>
                    typed ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Apply capture_ty)
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t
                          arg_ty ret lam_annot) rest annot))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIP (cons code [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v rest stack_annot) =>
        op_gtgteqquestion (fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (check_kind
                (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
                code)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion
                  (parse_instr type_logger (add_dip v stack_annot tc_context)
                    ctxt legacy code rest)
                  (fun function_parameter =>
                    let '(judgement, ctxt) := function_parameter in
                    match judgement with
                    | Typed descr =>
                      typed ctxt loc
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Dip descr)
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v
                          (aft descr) stack_annot)
                    | Failed _ =>
                      fail
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Fail_not_in_tail_position
                          loc)
                    end)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIP
          (cons n (cons code [])) result_annot, stack) =>
        let fix make_proof_argument {tstk : Type}
          (n : Z) (inner_tc_context : tc_context) (stk :
          Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty tstk)
          : Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (dipn_proof_argument tstk)) :=
          match
            ((Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
              n 0), stk) with
          | (true, rest) =>
            op_gtgteqquestion
              (parse_instr type_logger inner_tc_context ctxt legacy code rest)
              (fun function_parameter =>
                let '(judgement, ctxt) := function_parameter in
                match judgement with
                | Typed descr =>
                  op_atat outer_return
                    (Dipn_proof_argument
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Rest,
                        (ctxt, descr), (aft descr)))
                | Failed _ =>
                  fail
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.Fail_not_in_tail_position
                      loc)
                end)
          |
            (false, Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v rest annot)
            =>
            op_gtgteqquestion
              (make_proof_argument (op_minus n 1) (add_dip v annot tc_context)
                rest)
              (fun function_parameter =>
                let 'Dipn_proof_argument (n', descr, aft') := function_parameter
                  in
                op_atat outer_return
                  (Dipn_proof_argument
                    ((Tezos_raw_protocol_alpha.Script_typed_ir.Prefix n'),
                      descr,
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v aft'
                        annot))))
          | (_, _) =>
            op_gtgteqquestion (serialize_stack_for_error ctxt stack)
              (fun function_parameter =>
                let '(whole_stack, _ctxt) := function_parameter in
                fail
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                    loc Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIP 1
                    whole_stack))
          end in
        op_gtgteqquestion (Lwt.__return (parse_int32 n))
          (fun n =>
            op_gtgteqquestion (fail_unexpected_annot loc result_annot)
              (fun function_parameter =>
                let 'tt := function_parameter in
                op_gtgteqquestion (make_proof_argument n tc_context stack)
                  (fun function_parameter =>
                    let 'Dipn_proof_argument (n', (new_ctxt, descr), aft) :=
                      function_parameter in
                    typed new_ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Dipn n n' descr)
                      aft)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIP
          (([] | cons _ (cons _ (cons _ _))) as l) _, _) =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIP 2
            (List.length l))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_FAILWITH [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t v _rest _) =>
        op_gtgteqquestion (fail_unexpected_annot loc annot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            let descr {B : Type}
              (aft : Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty B)
              : Tezos_raw_protocol_alpha.Script_typed_ir.descr bef B :=
              {| loc := loc; bef := stack_ty; aft := aft;
                instr := Tezos_raw_protocol_alpha.Script_typed_ir.Failwith v |}
              in
            op_gtgteqquestion
              (log_stack ctxt loc stack_ty
                Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t)
              (fun function_parameter =>
                let 'tt := function_parameter in
                __return ctxt (Failed {| descr := descr |})))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc
              Tezos_raw_protocol_alpha.Script_typed_ir.Add_timestamp_to_seconds
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname)
                rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname) rest
              _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc
              Tezos_raw_protocol_alpha.Script_typed_ir.Add_seconds_to_timestamp
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname)
                rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc
              Tezos_raw_protocol_alpha.Script_typed_ir.Sub_timestamp_seconds
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tname)
                rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t tn2) rest _)
            _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Diff_timestamps
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONCAT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.String_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.String_t tn2) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Concat_string_pair
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.String_t tname)
                    rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONCAT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.List_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.String_t tname) _ _)
            rest list_annot) =>
        op_gtgteqquestion (parse_var_annot loc (Some list_annot) annot)
          (fun annot =>
            typed ctxt loc
              Tezos_raw_protocol_alpha.Script_typed_ir.Concat_string
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.String_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SLICE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.String_t tname) rest
                string_annot) _) _) =>
        op_gtgteqquestion
          (parse_var_annot loc
            (Some (gen_access_annot string_annot None default_slice_annot))
            annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Slice_string
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.String_t tname) None
                  false) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SIZE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.String_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.String_size
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t None) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONCAT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tn2) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Concat_bytes_pair
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tname)
                    rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONCAT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.List_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tname) _ _) rest
            list_annot) =>
        op_gtgteqquestion (parse_var_annot loc (Some list_annot) annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Concat_bytes
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SLICE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tname) rest
                bytes_annot) _) _) =>
        op_gtgteqquestion
          (parse_var_annot loc
            (Some (gen_access_annot bytes_annot None default_slice_annot)) annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Slice_bytes
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t tname) None
                  false) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SIZE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_size
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t None) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tn2) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Add_tez
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname)
                    rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tn2) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Sub_tez
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname)
                    rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Mul_teznat
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Mul_nattez
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_OR [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tn2) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Or
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_AND [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tn2) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.And
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_XOR [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tn2) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Xor
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Not
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ABS [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Abs_int
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t None) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ISNAT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest int_annot)
        =>
        op_gtgteqquestion (parse_var_annot loc (Some int_annot) annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Is_nat
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t None) None
                  false) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_INT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Int_nat
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t None) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEG [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Neg_int
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEG [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Neg_nat
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t None) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Add_intint
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Add_intnat
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Add_natint
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Add_natnat
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Sub_int
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Sub_int
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Sub_int
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun _tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Sub_int
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t None) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Mul_intint
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Mul_intnat
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Mul_natint
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Mul_natnat
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_teznat
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                    ((Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname),
                      None, None)
                    ((Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname),
                      None, None) None false) None false) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tn2) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_tez
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                        ((Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t None),
                          None, None)
                        ((Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t tname),
                          None, None) None false) None false) rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_intint
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                        ((Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname),
                          None, None)
                        ((Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t None),
                          None, None) None false) None false) rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_intnat
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                    ((Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname),
                      None, None)
                    ((Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t None),
                      None, None) None false) None false) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_natint
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                    ((Tezos_raw_protocol_alpha.Script_typed_ir.Int_t None),
                      None, None)
                    ((Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname),
                      None, None) None false) None false) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Ediv_natnat
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                        ((Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname),
                          None, None)
                        ((Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname),
                          None, None) None false) None false) rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSL [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Lsl_nat
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSR [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Lsr_nat
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_OR [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Or_nat
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_AND [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.And_nat
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_AND [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname) rest _) _)
        =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.And_int_nat
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_XOR [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn1)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tn2) rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (merge_type_annot legacy tn1 tn2))
              (fun tname =>
                typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Xor_nat
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t tname) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Not_int
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t tname) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Not_nat
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t None) rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_COMPARE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t1
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t2 rest _) _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            op_gtgteqquestion
              (check_item_ty ctxt t1 t2 loc
                Tezos_raw_protocol_alpha.Alpha_context.Script.I_COMPARE 1 2)
              (fun function_parameter =>
                let '(Eq, t, ctxt) := function_parameter in
                match comparable_ty_of_ty t with
                | None =>
                  op_gtgteqquestion
                    (Lwt.__return (serialize_ty_for_error ctxt t))
                    (fun function_parameter =>
                      let '(t, _ctxt) := function_parameter in
                      fail
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Comparable_type_expected
                          loc t))
                | Some key =>
                  typed ctxt loc
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Compare key)
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t None) rest
                      annot)
                end))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_EQ [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Eq
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEQ [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Neq
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_LT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Lt
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_GT [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Gt
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_LE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Le
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_GE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Ge
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CAST (cons cast_t [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t stack item_annot) =>
        op_gtgteqquestion (parse_var_annot loc (Some item_annot) annot)
          (fun annot =>
            op_gtgteqquestion
              (op_atat Lwt.__return (parse_any_ty ctxt legacy cast_t))
              (fun function_parameter =>
                let '(Ex_ty cast_t, ctxt) := function_parameter in
                op_gtgteqquestion (op_atat Lwt.__return (ty_eq ctxt cast_t t))
                  (fun function_parameter =>
                    let '(Eq, ctxt) := function_parameter in
                    op_gtgteqquestion
                      (op_atat Lwt.__return
                        (merge_types legacy ctxt loc cast_t t))
                      (fun function_parameter =>
                        let '(_, ctxt) := function_parameter in
                        typed ctxt loc
                          Tezos_raw_protocol_alpha.Script_typed_ir.Nop
                          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                            cast_t stack annot)))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_RENAME [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t stack _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Nop
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t stack annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_PACK [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t rest unpacked_annot)
        =>
        op_gtgteqquestion (Lwt.__return (check_packable true loc t))
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgteqquestion
              (parse_var_annot loc
                (Some (gen_access_annot unpacked_annot None default_pack_annot))
                annot)
              (fun annot =>
                typed ctxt loc (Tezos_raw_protocol_alpha.Script_typed_ir.Pack t)
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t None) rest
                    annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_UNPACK (cons ty [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _) rest
            packed_annot) =>
        op_gtgteqquestion
          (op_atat Lwt.__return (parse_packable_ty ctxt legacy ty))
          (fun function_parameter =>
            let '(Ex_ty t, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_type_annot loc annot)
              (fun function_parameter =>
                let '(annot, ty_name) := function_parameter in
                let annot :=
                  default_annot
                    (gen_access_annot packed_annot None default_unpack_annot)
                    annot in
                typed ctxt loc
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Unpack t)
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t t ty_name
                      false) rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADDRESS [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t _ _) rest
            contract_annot) =>
        op_gtgteqquestion
          (parse_var_annot loc
            (Some (gen_access_annot contract_annot None default_addr_annot))
            annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Address
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONTRACT (cons ty [])
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _) rest
            addr_annot) =>
        op_gtgteqquestion
          (op_atat Lwt.__return (parse_parameter_ty ctxt legacy ty))
          (fun function_parameter =>
            let '(Ex_ty t, ctxt) := function_parameter in
            op_gtgteqquestion
              (parse_entrypoint_annot loc
                (Some (gen_access_annot addr_annot None default_contract_annot))
                annot)
              (fun function_parameter =>
                let '(annot, entrypoint) := function_parameter in
                op_gtgteqquestion
                  (op_atat Lwt.__return
                    match entrypoint with
                    | None =>
                      Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                        "default" % string
                    | Some (Field_annot "default" % string) =>
                      error
                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
                          loc)
                    | Some (Field_annot entrypoint) =>
                      if
                        Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
                          (String.length entrypoint) 31 then
                        error
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.Entrypoint_name_too_long
                            entrypoint)
                      else
                        Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                          entrypoint
                    end)
                  (fun entrypoint =>
                    typed ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Contract t
                        entrypoint)
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                          (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t t
                            None) None false) rest annot))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_TRANSFER_TOKENS []
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t p
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t cp _) rest
                _) _) _) =>
        op_gtgteqquestion
          (check_item_ty ctxt p cp loc
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_TRANSFER_TOKENS 1 4)
          (fun function_parameter =>
            let '(Eq, _, ctxt) := function_parameter in
            op_gtgteqquestion (parse_var_annot loc None annot)
              (fun annot =>
                typed ctxt loc
                  Tezos_raw_protocol_alpha.Script_typed_ir.Transfer_tokens
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t None)
                    rest annot)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SET_DELEGATE [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _) _ _) rest
            _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Set_delegate
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_ACCOUNT []
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _) _ _)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _)
                (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _) rest _) _)
              _) _) =>
        if legacy then
          op_gtgteqquestion (parse_two_var_annot loc annot)
            (fun function_parameter =>
              let '(op_annot, addr_annot) := function_parameter in
              typed ctxt loc
                Tezos_raw_protocol_alpha.Script_typed_ir.Create_account
                (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t None)
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t None)
                    rest addr_annot) op_annot))
        else
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Deprecated_instruction
              Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_ACCOUNT)
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_IMPLICIT_ACCOUNT []
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc
              Tezos_raw_protocol_alpha.Script_typed_ir.Implicit_account
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t None) None)
                rest annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_CONTRACT
          (cons
            ((Tezos_protocol_environment_alpha__Environment.Micheline.Seq _ _)
              as code) []) annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _) _ _)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _)
                (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _)
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _)
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ginit rest
                      _) _) _) _) _) _) =>
        if legacy then
          op_gtgteqquestion (parse_two_var_annot loc annot)
            (fun function_parameter =>
              let '(op_annot, addr_annot) := function_parameter in
              let cannonical_code :=
                op_atat fst (Micheline.extract_locations code) in
              op_gtgteqquestion
                (op_atat Lwt.__return (parse_toplevel legacy cannonical_code))
                (fun function_parameter =>
                  let '(arg_type, storage_type, code_field, root_name) :=
                    function_parameter in
                  op_gtgteqquestion
                    (trace
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
                        (Some "parameter" % string) cannonical_code
                        (location arg_type))
                      (op_atat Lwt.__return
                        (parse_parameter_ty ctxt legacy arg_type)))
                    (fun function_parameter =>
                      let '(Ex_ty arg_type, ctxt) := function_parameter in
                      op_gtgteqquestion
                        (if legacy then
                          Error_monad.__return tt
                        else
                          Lwt.__return
                            (well_formed_entrypoints arg_type root_name))
                        (fun function_parameter =>
                          let 'tt := function_parameter in
                          op_gtgteqquestion
                            (trace
                              (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
                                (Some "storage" % string) cannonical_code
                                (location storage_type))
                              (op_atat Lwt.__return
                                (parse_storage_ty ctxt legacy storage_type)))
                            (fun function_parameter =>
                              let '(Ex_ty storage_type, ctxt) :=
                                function_parameter in
                              let arg_annot :=
                                default_annot default_param_annot
                                  (type_to_var_annot (name_of_ty arg_type)) in
                              let storage_annot :=
                                default_annot default_storage_annot
                                  (type_to_var_annot (name_of_ty storage_type))
                                in
                              let arg_type_full :=
                                Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                                  (arg_type, None, arg_annot)
                                  (storage_type, None, storage_annot) None
                                  (op_pipepipe (has_big_map arg_type)
                                    (has_big_map storage_type)) in
                              let ret_type_full :=
                                Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                                  ((Tezos_raw_protocol_alpha.Script_typed_ir.List_t
                                    (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t
                                      None) None false), None, None)
                                  (storage_type, None, None) None
                                  (has_big_map storage_type) in
                              op_gtgteqquestion
                                (trace
                                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_contract
                                    cannonical_code [])
                                  (parse_returning type_logger
                                    (Toplevel
                                      {| storage_type := storage_type;
                                        param_type := arg_type;
                                        root_name := root_name;
                                        legacy_create_contract_literal := true
                                        |}) ctxt legacy (arg_type_full, None)
                                    ret_type_full code_field))
                                (fun function_parameter =>
                                  let
                                    '((Tezos_raw_protocol_alpha.Script_typed_ir.Lam
                                      {|
                                      bef :=
                                        Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                          arg
                                          Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t
                                          _;
                                        aft :=
                                          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                            ret
                                            Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t
                                            _
                                        |} _) as lambda, ctxt) :=
                                    function_parameter in
                                  op_gtgteqquestion
                                    (op_atat Lwt.__return
                                      (ty_eq ctxt arg arg_type_full))
                                    (fun function_parameter =>
                                      let '(Eq, ctxt) := function_parameter in
                                      op_gtgteqquestion
                                        (op_atat Lwt.__return
                                          (merge_types legacy ctxt loc arg
                                            arg_type_full))
                                        (fun function_parameter =>
                                          let '(_, ctxt) := function_parameter
                                            in
                                          op_gtgteqquestion
                                            (op_atat Lwt.__return
                                              (ty_eq ctxt ret ret_type_full))
                                            (fun function_parameter =>
                                              let '(Eq, ctxt) :=
                                                function_parameter in
                                              op_gtgteqquestion
                                                (op_atat Lwt.__return
                                                  (merge_types legacy ctxt loc
                                                    ret ret_type_full))
                                                (fun function_parameter =>
                                                  let '(_, ctxt) :=
                                                    function_parameter in
                                                  op_gtgteqquestion
                                                    (op_atat Lwt.__return
                                                      (ty_eq ctxt storage_type
                                                        ginit))
                                                    (fun function_parameter =>
                                                      let '(Eq, ctxt) :=
                                                        function_parameter in
                                                      op_gtgteqquestion
                                                        (op_atat Lwt.__return
                                                          (merge_types legacy
                                                            ctxt loc
                                                            storage_type ginit))
                                                        (fun function_parameter
                                                          =>
                                                          let '(_, ctxt) :=
                                                            function_parameter
                                                            in
                                                          typed ctxt loc
                                                            (Tezos_raw_protocol_alpha.Script_typed_ir.Create_contract
                                                              storage_type
                                                              arg_type lambda
                                                              root_name)
                                                            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                                              (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t
                                                                None)
                                                              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                                                (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t
                                                                  None) rest
                                                                addr_annot)
                                                              op_annot)))))))))))))
        else
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Deprecated_instruction
              Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_CONTRACT)
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_CONTRACT
          (cons
            ((Tezos_protocol_environment_alpha__Environment.Micheline.Seq _ _)
              as code) []) annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _) _ _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ginit rest _) _)
            _) =>
        op_gtgteqquestion (parse_two_var_annot loc annot)
          (fun function_parameter =>
            let '(op_annot, addr_annot) := function_parameter in
            let cannonical_code :=
              op_atat fst (Micheline.extract_locations code) in
            op_gtgteqquestion
              (op_atat Lwt.__return (parse_toplevel legacy cannonical_code))
              (fun function_parameter =>
                let '(arg_type, storage_type, code_field, root_name) :=
                  function_parameter in
                op_gtgteqquestion
                  (trace
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
                      (Some "parameter" % string) cannonical_code
                      (location arg_type))
                    (op_atat Lwt.__return
                      (parse_parameter_ty ctxt legacy arg_type)))
                  (fun function_parameter =>
                    let '(Ex_ty arg_type, ctxt) := function_parameter in
                    op_gtgteqquestion
                      (if legacy then
                        Error_monad.__return tt
                      else
                        Lwt.__return
                          (well_formed_entrypoints arg_type root_name))
                      (fun function_parameter =>
                        let 'tt := function_parameter in
                        op_gtgteqquestion
                          (trace
                            (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
                              (Some "storage" % string) cannonical_code
                              (location storage_type))
                            (op_atat Lwt.__return
                              (parse_storage_ty ctxt legacy storage_type)))
                          (fun function_parameter =>
                            let '(Ex_ty storage_type, ctxt) :=
                              function_parameter in
                            let arg_annot :=
                              default_annot default_param_annot
                                (type_to_var_annot (name_of_ty arg_type)) in
                            let storage_annot :=
                              default_annot default_storage_annot
                                (type_to_var_annot (name_of_ty storage_type)) in
                            let arg_type_full :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                                (arg_type, None, arg_annot)
                                (storage_type, None, storage_annot) None
                                (op_pipepipe (has_big_map arg_type)
                                  (has_big_map storage_type)) in
                            let ret_type_full :=
                              Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                                ((Tezos_raw_protocol_alpha.Script_typed_ir.List_t
                                  (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t
                                    None) None false), None, None)
                                (storage_type, None, None) None
                                (has_big_map storage_type) in
                            op_gtgteqquestion
                              (trace
                                (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_contract
                                  cannonical_code [])
                                (parse_returning type_logger
                                  (Toplevel
                                    {| storage_type := storage_type;
                                      param_type := arg_type;
                                      root_name := root_name;
                                      legacy_create_contract_literal := false |})
                                  ctxt legacy (arg_type_full, None)
                                  ret_type_full code_field))
                              (fun function_parameter =>
                                let
                                  '((Tezos_raw_protocol_alpha.Script_typed_ir.Lam
                                    {|
                                    bef :=
                                      Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                        arg
                                        Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t
                                        _;
                                      aft :=
                                        Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                          ret
                                          Tezos_raw_protocol_alpha.Script_typed_ir.Empty_t
                                          _
                                      |} _) as lambda, ctxt) :=
                                  function_parameter in
                                op_gtgteqquestion
                                  (op_atat Lwt.__return
                                    (ty_eq ctxt arg arg_type_full))
                                  (fun function_parameter =>
                                    let '(Eq, ctxt) := function_parameter in
                                    op_gtgteqquestion
                                      (op_atat Lwt.__return
                                        (merge_types legacy ctxt loc arg
                                          arg_type_full))
                                      (fun function_parameter =>
                                        let '(_, ctxt) := function_parameter in
                                        op_gtgteqquestion
                                          (op_atat Lwt.__return
                                            (ty_eq ctxt ret ret_type_full))
                                          (fun function_parameter =>
                                            let '(Eq, ctxt) :=
                                              function_parameter in
                                            op_gtgteqquestion
                                              (op_atat Lwt.__return
                                                (merge_types legacy ctxt loc ret
                                                  ret_type_full))
                                              (fun function_parameter =>
                                                let '(_, ctxt) :=
                                                  function_parameter in
                                                op_gtgteqquestion
                                                  (op_atat Lwt.__return
                                                    (ty_eq ctxt storage_type
                                                      ginit))
                                                  (fun function_parameter =>
                                                    let '(Eq, ctxt) :=
                                                      function_parameter in
                                                    op_gtgteqquestion
                                                      (op_atat Lwt.__return
                                                        (merge_types legacy ctxt
                                                          loc storage_type ginit))
                                                      (fun function_parameter =>
                                                        let '(_, ctxt) :=
                                                          function_parameter in
                                                        typed ctxt loc
                                                          (Tezos_raw_protocol_alpha.Script_typed_ir.Create_contract_2
                                                            storage_type
                                                            arg_type lambda
                                                            root_name)
                                                          (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                                            (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t
                                                              None)
                                                            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                                                              (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t
                                                                None) rest
                                                              addr_annot)
                                                            op_annot)))))))))))))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOW [] annot, stack)
        =>
        op_gtgteqquestion (parse_var_annot loc (Some default_now_annot) annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Now
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t None)
                stack annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_AMOUNT [] annot, stack)
        =>
        op_gtgteqquestion
          (parse_var_annot loc (Some default_amount_annot) annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Amount
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t None) stack
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CHAIN_ID [] annot,
          stack) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.ChainId
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t None) stack
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_BALANCE [] annot,
          stack) =>
        op_gtgteqquestion
          (parse_var_annot loc (Some default_balance_annot) annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Balance
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t None) stack
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_HASH_KEY [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Hash_key
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CHECK_SIGNATURE []
          annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _)
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
              (Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _)
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _) rest _) _)
            _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc
              Tezos_raw_protocol_alpha.Script_typed_ir.Check_signature
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_BLAKE2B [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Blake2b
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SHA256 [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Sha256
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SHA512 [] annot,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
            (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _) rest _) =>
        op_gtgteqquestion (parse_var_annot loc None annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Sha512
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t None) rest
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_STEPS_TO_QUOTA []
          annot, stack) =>
        if legacy then
          op_gtgteqquestion
            (parse_var_annot loc (Some default_steps_annot) annot)
            (fun annot =>
              typed ctxt loc
                Tezos_raw_protocol_alpha.Script_typed_ir.Steps_to_quota
                (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t None) stack
                  annot))
        else
          fail
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Deprecated_instruction
              Tezos_raw_protocol_alpha.Alpha_context.Script.I_STEPS_TO_QUOTA)
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SOURCE [] annot, stack)
        =>
        op_gtgteqquestion
          (parse_var_annot loc (Some default_source_annot) annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Source
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t None) stack
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SENDER [] annot, stack)
        =>
        op_gtgteqquestion
          (parse_var_annot loc (Some default_sender_annot) annot)
          (fun annot =>
            typed ctxt loc Tezos_raw_protocol_alpha.Script_typed_ir.Sender
              (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t None) stack
                annot))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_SELF [] annot, stack)
        =>
        op_gtgteqquestion
          (parse_entrypoint_annot loc (Some default_self_annot) annot)
          (fun function_parameter =>
            let '(annot, entrypoint) := function_parameter in
            let entrypoint :=
              Option.unopt_map
                (fun function_parameter =>
                  let 'Field_annot annot := function_parameter in
                  annot) "default" % string entrypoint in
            let fix get_toplevel_type (function_parameter : tc_context)
              : Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                  (judgement bef *
                    Tezos_raw_protocol_alpha.Alpha_context.context)) :=
              match function_parameter with
              | Lambda =>
                fail
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Self_in_lambda
                    loc)
              | Dip _ prev => get_toplevel_type prev
              |
                Toplevel {|
                  param_type := param_type;
                    root_name := root_name;
                    legacy_create_contract_literal := false
                    |} =>
                op_gtgteqquestion
                  (Lwt.__return
                    (find_entrypoint param_type root_name entrypoint))
                  (fun function_parameter =>
                    let '(_, Ex_ty param_type) := function_parameter in
                    typed ctxt loc
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Self param_type
                        entrypoint)
                      (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t
                          param_type None) stack annot))
              |
                Toplevel {|
                  param_type := param_type;
                    root_name := _;
                    legacy_create_contract_literal := true
                    |} =>
                typed ctxt loc
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Self param_type
                    "default" % string)
                  (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t
                    (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t
                      param_type None) stack annot)
              end in
            get_toplevel_type tc_context)
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SWAP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SOME |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_UNIT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_PAIR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CAR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CDR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONS |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONCAT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SLICE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_MEM |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_MAP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GET |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EXEC |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_FAILWITH |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SIZE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_OR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_AND |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_XOR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_ABS |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEG |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSL |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_COMPARE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EQ |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEQ |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_TRANSFER_TOKENS |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_ACCOUNT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SET_DELEGATE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOW |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IMPLICIT_ACCOUNT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_AMOUNT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_BALANCE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CHECK_SIGNATURE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_HASH_KEY |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SOURCE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SENDER |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_BLAKE2B |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SHA256 |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SHA512 |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_STEPS_TO_QUOTA |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADDRESS) as name)
          ((cons _ _) as l) _, _) =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc name 0 (List.length l))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.I_NONE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LEFT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_RIGHT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_NIL |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_MAP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_ITER |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EMPTY_SET |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LOOP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LOOP_LEFT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONTRACT) as name)
          (([] | cons _ (cons _ _)) as l) _, _) =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc name 1 (List.length l))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.I_PUSH |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_NONE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_LEFT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_CONS |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EMPTY_MAP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF) as name)
          (([] | cons _ [] | cons _ (cons _ (cons _ _))) as l) _, _) =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc name 2 (List.length l))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_LAMBDA
          (([] | cons _ [] | cons _ (cons _ (cons _ (cons _ _)))) as l) _, _) =>
        fail
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc Tezos_raw_protocol_alpha.Alpha_context.Script.I_LAMBDA 3
            (List.length l))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_AND |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_OR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_XOR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSL |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSR) as name) [] _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t ta
            (Tezos_raw_protocol_alpha.Script_typed_ir.Item_t tb _ _) _) =>
        op_gtgteqquestion
          (op_atat Lwt.__return (serialize_ty_for_error ctxt ta))
          (fun function_parameter =>
            let '(ta, ctxt) := function_parameter in
            op_gtgteqquestion
              (op_atat Lwt.__return (serialize_ty_for_error ctxt tb))
              (fun function_parameter =>
                let '(tb, _ctxt) := function_parameter in
                fail
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Undefined_binop
                    loc name ta tb)))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEG |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_ABS |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONCAT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SIZE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EQ |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEQ |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GE) as name) [] _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Item_t t _ _) =>
        op_gtgteqquestion (op_atat Lwt.__return (serialize_ty_for_error ctxt t))
          (fun function_parameter =>
            let '(t, _ctxt) := function_parameter in
            fail
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Undefined_unop
                loc name t))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SLICE) as name) [] _,
          stack) =>
        op_gtgteqquestion (serialize_stack_for_error ctxt stack)
          (fun function_parameter =>
            let '(stack, _ctxt) := function_parameter in
            fail
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                loc name 3 stack))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_CONTRACT _ _,
          stack) =>
        op_gtgteqquestion (serialize_stack_for_error ctxt stack)
          (fun function_parameter =>
            let '(stack, _ctxt) := function_parameter in
            fail
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                loc
                Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_CONTRACT
                7 stack))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_ACCOUNT [] _,
          stack) =>
        op_gtgteqquestion (serialize_stack_for_error ctxt stack)
          (fun function_parameter =>
            let '(stack, _ctxt) := function_parameter in
            fail
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                loc
                Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_ACCOUNT 4
                stack))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          Tezos_raw_protocol_alpha.Alpha_context.Script.I_TRANSFER_TOKENS [] _,
          stack) =>
        op_gtgteqquestion (serialize_stack_for_error ctxt stack)
          (fun function_parameter =>
            let '(stack, _ctxt) := function_parameter in
            fail
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                loc
                Tezos_raw_protocol_alpha.Alpha_context.Script.I_TRANSFER_TOKENS
                4 stack))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.I_DROP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CAR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CDR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SOME |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_BLAKE2B |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SHA256 |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SHA512 |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_NONE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LEFT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_RIGHT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_LEFT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LOOP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_CONS |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IMPLICIT_ACCOUNT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEG |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_ABS |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_INT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_HASH_KEY |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EQ |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEQ |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GT |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GE) as name) _ _,
          stack) =>
        op_gtgteqquestion (serialize_stack_for_error ctxt stack)
          (fun function_parameter =>
            let '(stack, _ctxt) := function_parameter in
            fail
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                loc name 1 stack))
      |
        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
          ((Tezos_raw_protocol_alpha.Alpha_context.Script.I_SWAP |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_PAIR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONS |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GET |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_MEM |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EXEC |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CHECK_SIGNATURE |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_AND |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_OR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_XOR |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSL |
            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSR) as name) _ _,
          stack) =>
        op_gtgteqquestion (serialize_stack_for_error ctxt stack)
          (fun function_parameter =>
            let '(stack, _ctxt) := function_parameter in
            fail
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
                loc name 2 stack))
      | (expr, _) =>
        op_atat fail
          (unexpected expr
            (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
            Tezos_raw_protocol_alpha.Script_tc_errors.Instr_namespace
            (cons Tezos_raw_protocol_alpha.Alpha_context.Script.I_DROP
              (cons Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUP
                (cons Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIG
                  (cons Tezos_raw_protocol_alpha.Alpha_context.Script.I_DUG
                    (cons Tezos_raw_protocol_alpha.Alpha_context.Script.I_SWAP
                      (cons Tezos_raw_protocol_alpha.Alpha_context.Script.I_SOME
                        (cons
                          Tezos_raw_protocol_alpha.Alpha_context.Script.I_UNIT
                          (cons
                            Tezos_raw_protocol_alpha.Alpha_context.Script.I_PAIR
                            (cons
                              Tezos_raw_protocol_alpha.Alpha_context.Script.I_CAR
                              (cons
                                Tezos_raw_protocol_alpha.Alpha_context.Script.I_CDR
                                (cons
                                  Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONS
                                  (cons
                                    Tezos_raw_protocol_alpha.Alpha_context.Script.I_MEM
                                    (cons
                                      Tezos_raw_protocol_alpha.Alpha_context.Script.I_UPDATE
                                      (cons
                                        Tezos_raw_protocol_alpha.Alpha_context.Script.I_MAP
                                        (cons
                                          Tezos_raw_protocol_alpha.Alpha_context.Script.I_ITER
                                          (cons
                                            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GET
                                            (cons
                                              Tezos_raw_protocol_alpha.Alpha_context.Script.I_EXEC
                                              (cons
                                                Tezos_raw_protocol_alpha.Alpha_context.Script.I_FAILWITH
                                                (cons
                                                  Tezos_raw_protocol_alpha.Alpha_context.Script.I_SIZE
                                                  (cons
                                                    Tezos_raw_protocol_alpha.Alpha_context.Script.I_CONCAT
                                                    (cons
                                                      Tezos_raw_protocol_alpha.Alpha_context.Script.I_ADD
                                                      (cons
                                                        Tezos_raw_protocol_alpha.Alpha_context.Script.I_SUB
                                                        (cons
                                                          Tezos_raw_protocol_alpha.Alpha_context.Script.I_MUL
                                                          (cons
                                                            Tezos_raw_protocol_alpha.Alpha_context.Script.I_EDIV
                                                            (cons
                                                              Tezos_raw_protocol_alpha.Alpha_context.Script.I_OR
                                                              (cons
                                                                Tezos_raw_protocol_alpha.Alpha_context.Script.I_AND
                                                                (cons
                                                                  Tezos_raw_protocol_alpha.Alpha_context.Script.I_XOR
                                                                  (cons
                                                                    Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOT
                                                                    (cons
                                                                      Tezos_raw_protocol_alpha.Alpha_context.Script.I_ABS
                                                                      (cons
                                                                        Tezos_raw_protocol_alpha.Alpha_context.Script.I_INT
                                                                        (cons
                                                                          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEG
                                                                          (cons
                                                                            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSL
                                                                            (cons
                                                                              Tezos_raw_protocol_alpha.Alpha_context.Script.I_LSR
                                                                              (cons
                                                                                Tezos_raw_protocol_alpha.Alpha_context.Script.I_COMPARE
                                                                                (cons
                                                                                  Tezos_raw_protocol_alpha.Alpha_context.Script.I_EQ
                                                                                  (cons
                                                                                    Tezos_raw_protocol_alpha.Alpha_context.Script.I_NEQ
                                                                                    (cons
                                                                                      Tezos_raw_protocol_alpha.Alpha_context.Script.I_LT
                                                                                      (cons
                                                                                        Tezos_raw_protocol_alpha.Alpha_context.Script.I_GT
                                                                                        (cons
                                                                                          Tezos_raw_protocol_alpha.Alpha_context.Script.I_LE
                                                                                          (cons
                                                                                            Tezos_raw_protocol_alpha.Alpha_context.Script.I_GE
                                                                                            (cons
                                                                                              Tezos_raw_protocol_alpha.Alpha_context.Script.I_TRANSFER_TOKENS
                                                                                              (cons
                                                                                                Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_ACCOUNT
                                                                                                (cons
                                                                                                  Tezos_raw_protocol_alpha.Alpha_context.Script.I_CREATE_CONTRACT
                                                                                                  (cons
                                                                                                    Tezos_raw_protocol_alpha.Alpha_context.Script.I_NOW
                                                                                                    (cons
                                                                                                      Tezos_raw_protocol_alpha.Alpha_context.Script.I_AMOUNT
                                                                                                      (cons
                                                                                                        Tezos_raw_protocol_alpha.Alpha_context.Script.I_BALANCE
                                                                                                        (cons
                                                                                                          Tezos_raw_protocol_alpha.Alpha_context.Script.I_IMPLICIT_ACCOUNT
                                                                                                          (cons
                                                                                                            Tezos_raw_protocol_alpha.Alpha_context.Script.I_CHECK_SIGNATURE
                                                                                                            (cons
                                                                                                              Tezos_raw_protocol_alpha.Alpha_context.Script.I_BLAKE2B
                                                                                                              (cons
                                                                                                                Tezos_raw_protocol_alpha.Alpha_context.Script.I_SHA256
                                                                                                                (cons
                                                                                                                  Tezos_raw_protocol_alpha.Alpha_context.Script.I_SHA512
                                                                                                                  (cons
                                                                                                                    Tezos_raw_protocol_alpha.Alpha_context.Script.I_HASH_KEY
                                                                                                                    (cons
                                                                                                                      Tezos_raw_protocol_alpha.Alpha_context.Script.I_STEPS_TO_QUOTA
                                                                                                                      (cons
                                                                                                                        Tezos_raw_protocol_alpha.Alpha_context.Script.I_PUSH
                                                                                                                        (cons
                                                                                                                          Tezos_raw_protocol_alpha.Alpha_context.Script.I_NONE
                                                                                                                          (cons
                                                                                                                            Tezos_raw_protocol_alpha.Alpha_context.Script.I_LEFT
                                                                                                                            (cons
                                                                                                                              Tezos_raw_protocol_alpha.Alpha_context.Script.I_RIGHT
                                                                                                                              (cons
                                                                                                                                Tezos_raw_protocol_alpha.Alpha_context.Script.I_NIL
                                                                                                                                (cons
                                                                                                                                  Tezos_raw_protocol_alpha.Alpha_context.Script.I_EMPTY_SET
                                                                                                                                  (cons
                                                                                                                                    Tezos_raw_protocol_alpha.Alpha_context.Script.I_DIP
                                                                                                                                    (cons
                                                                                                                                      Tezos_raw_protocol_alpha.Alpha_context.Script.I_LOOP
                                                                                                                                      (cons
                                                                                                                                        Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_NONE
                                                                                                                                        (cons
                                                                                                                                          Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_LEFT
                                                                                                                                          (cons
                                                                                                                                            Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF_CONS
                                                                                                                                            (cons
                                                                                                                                              Tezos_raw_protocol_alpha.Alpha_context.Script.I_EMPTY_MAP
                                                                                                                                              (cons
                                                                                                                                                Tezos_raw_protocol_alpha.Alpha_context.Script.I_IF
                                                                                                                                                (cons
                                                                                                                                                  Tezos_raw_protocol_alpha.Alpha_context.Script.I_SOURCE
                                                                                                                                                  (cons
                                                                                                                                                    Tezos_raw_protocol_alpha.Alpha_context.Script.I_SENDER
                                                                                                                                                    (cons
                                                                                                                                                      Tezos_raw_protocol_alpha.Alpha_context.Script.I_SELF
                                                                                                                                                      (cons
                                                                                                                                                        Tezos_raw_protocol_alpha.Alpha_context.Script.I_LAMBDA
                                                                                                                                                        [])))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
      end)

with parse_contract {arg : Type}
  (legacy : bool) (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (arg : Tezos_raw_protocol_alpha.Script_typed_ir.ty arg)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.t)
  (entrypoint : string)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.context *
        Tezos_raw_protocol_alpha.Script_typed_ir.typed_contract arg)) :=
  op_gtgteqquestion
    (op_atat Lwt.__return (Gas.consume ctxt Typecheck_costs.contract_exists))
    (fun ctxt =>
      op_gtgteqquestion (Contract.__exists ctxt contract)
        (fun function_parameter =>
          match function_parameter with
          | false =>
            fail
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_contract
                loc contract)
          | true =>
            op_gtgteqquestion
              (op_atat Lwt.__return
                (Gas.consume ctxt Typecheck_costs.get_script))
              (fun ctxt =>
                op_gtgteqquestion
                  (op_atat
                    (trace
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_contract
                        loc contract)) (Contract.get_script_code ctxt contract))
                  (fun function_parameter =>
                    let '(ctxt, code) := function_parameter in
                    match code with
                    | None =>
                      Lwt.__return
                        (op_gtgtquestion
                          (ty_eq ctxt arg
                            (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t
                              None))
                          (fun function_parameter =>
                            let '(Eq, ctxt) := function_parameter in
                            match entrypoint with
                            | "default" % string =>
                              let contract := (arg, (contract, entrypoint)) in
                              ok (ctxt, contract)
                            | entrypoint =>
                              error
                                (Tezos_protocol_environment_alpha__Environment.Error_monad.No_such_entrypoint
                                  entrypoint)
                            end))
                    | Some code =>
                      op_gtgteqquestion (Script.force_decode ctxt code)
                        (fun function_parameter =>
                          let '(code, ctxt) := function_parameter in
                          Lwt.__return
                            (op_gtgtquestion (parse_toplevel true code)
                              (fun function_parameter =>
                                let '(arg_type, _, _, root_name) :=
                                  function_parameter in
                                op_gtgtquestion
                                  (parse_parameter_ty ctxt true arg_type)
                                  (fun function_parameter =>
                                    let '(Ex_ty targ, ctxt) :=
                                      function_parameter in
                                    let __return
                                      (ctxt :
                                      Tezos_raw_protocol_alpha.Alpha_context.context)
                                      (targ :
                                      Tezos_raw_protocol_alpha.Script_typed_ir.ty
                                        arg) (entrypoint : string)
                                      : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                                        (Tezos_raw_protocol_alpha.Alpha_context.context
                                          *
                                          Tezos_raw_protocol_alpha.Script_typed_ir.typed_contract
                                            arg) :=
                                      op_gtgtquestion
                                        (merge_types legacy ctxt loc targ arg)
                                        (fun function_parameter =>
                                          let '(arg, ctxt) := function_parameter
                                            in
                                          let contract :=
                                            (arg, (contract, entrypoint)) in
                                          ok (ctxt, contract)) in
                                    op_gtgtquestion
                                      (find_entrypoint_for_type targ arg
                                        root_name entrypoint ctxt)
                                      (fun function_parameter =>
                                        let '(ctxt, entrypoint, targ) :=
                                          function_parameter in
                                        op_gtgtquestion
                                          (merge_types legacy ctxt loc targ arg)
                                          (fun function_parameter =>
                                            let '(targ, ctxt) :=
                                              function_parameter in
                                            __return ctxt targ entrypoint))))))
                    end))
          end))

with parse_contract_for_script {arg : Type}
  (legacy : bool) (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (loc : Tezos_raw_protocol_alpha.Alpha_context.Script.location)
  (arg : Tezos_raw_protocol_alpha.Script_typed_ir.ty arg)
  (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.t)
  (entrypoint : string)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.context *
        option (Tezos_raw_protocol_alpha.Script_typed_ir.typed_contract arg))) :=
  op_gtgteqquestion
    (op_atat Lwt.__return (Gas.consume ctxt Typecheck_costs.contract_exists))
    (fun ctxt =>
      op_gtgteqquestion (Contract.__exists ctxt contract)
        (fun function_parameter =>
          match function_parameter with
          | false => __return (ctxt, None)
          | true =>
            op_gtgteqquestion
              (op_atat Lwt.__return
                (Gas.consume ctxt Typecheck_costs.get_script))
              (fun ctxt =>
                op_gtgteqquestion
                  (op_atat
                    (trace
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_contract
                        loc contract)) (Contract.get_script_code ctxt contract))
                  (fun function_parameter =>
                    let '(ctxt, code) := function_parameter in
                    match code with
                    | None =>
                      match entrypoint with
                      | "default" % string =>
                        Lwt.__return
                          match
                            ty_eq ctxt arg
                              (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t
                                None) with
                          |
                            Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                              (Eq, ctxt) =>
                            let contract := (arg, (contract, entrypoint)) in
                            ok (ctxt, (Some contract))
                          |
                            Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                              _ =>
                            op_gtgtquestion
                              (Gas.consume ctxt Typecheck_costs.cycle)
                              (fun ctxt => ok (ctxt, None))
                          end
                      | _ => __return (ctxt, None)
                      end
                    | Some code =>
                      op_gtgteqquestion (Script.force_decode ctxt code)
                        (fun function_parameter =>
                          let '(code, ctxt) := function_parameter in
                          Lwt.__return
                            match parse_toplevel true code with
                            |
                              Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                                _ =>
                              error
                                (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_contract
                                  loc contract)
                            |
                              Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                                (arg_type, _, _, root_name) =>
                              match parse_parameter_ty ctxt true arg_type with
                              |
                                Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                                  _ =>
                                error
                                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_contract
                                    loc contract)
                              |
                                Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                                  (Ex_ty targ, ctxt) =>
                                match
                                  op_gtgtquestion
                                    (find_entrypoint_for_type targ arg root_name
                                      entrypoint ctxt)
                                    (fun function_parameter =>
                                      let '(ctxt, entrypoint, targ) :=
                                        function_parameter in
                                      op_gtgtquestion
                                        (merge_types legacy ctxt loc targ arg)
                                        (fun function_parameter =>
                                          let '(targ, ctxt) :=
                                            function_parameter in
                                          op_gtgtquestion
                                            (merge_types legacy ctxt loc targ
                                              arg)
                                            (fun function_parameter =>
                                              let '(arg, ctxt) :=
                                                function_parameter in
                                              let contract :=
                                                (arg, (contract, entrypoint)) in
                                              ok (ctxt, (Some contract))))) with
                                |
                                  Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                                    res => ok res
                                |
                                  Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                                    _ =>
                                  op_gtgtquestion (ty_eq ctxt targ targ)
                                    (fun function_parameter =>
                                      let '(Eq, ctxt) := function_parameter in
                                      op_gtgtquestion
                                        (merge_types legacy ctxt loc targ targ)
                                        (fun function_parameter =>
                                          let '(_, ctxt) := function_parameter
                                            in
                                          ok (ctxt, None)))
                                end
                              end
                            end)
                    end))
          end))

with parse_toplevel
  (legacy : bool)
  (toplevel : Tezos_raw_protocol_alpha.Alpha_context.Script.expr)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_raw_protocol_alpha.Alpha_context.Script.node *
      Tezos_raw_protocol_alpha.Alpha_context.Script.node *
      Tezos_raw_protocol_alpha.Alpha_context.Script.node * option string) :=
  op_atat
    (record_trace
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_contract
        toplevel []))
    match root toplevel with
    | Tezos_protocol_environment_alpha__Environment.Micheline.Int loc _ =>
      error
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
          loc (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
          Tezos_raw_protocol_alpha.Script_tc_errors.Int_kind)
    | Tezos_protocol_environment_alpha__Environment.Micheline.String loc _ =>
      error
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
          loc (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
          Tezos_raw_protocol_alpha.Script_tc_errors.String_kind)
    | Tezos_protocol_environment_alpha__Environment.Micheline.Bytes loc _ =>
      error
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
          loc (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
          Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind)
    | Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc _ _ _ =>
      error
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
          loc (cons Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind [])
          Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind)
    | Tezos_protocol_environment_alpha__Environment.Micheline.Seq _ fields =>
      let fix find_fields
        (p :
        option
          (Tezos_protocol_environment_alpha__Environment.Micheline.node
            Tezos_raw_protocol_alpha.Alpha_context.Script.location
            Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
            Tezos_raw_protocol_alpha.Alpha_context.Script.location *
            Tezos_protocol_environment_alpha__Environment.Micheline.annot)) (s :
        option
          (Tezos_protocol_environment_alpha__Environment.Micheline.node
            Tezos_raw_protocol_alpha.Alpha_context.Script.location
            Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
            Tezos_raw_protocol_alpha.Alpha_context.Script.location *
            Tezos_protocol_environment_alpha__Environment.Micheline.annot)) (c :
        option
          (Tezos_protocol_environment_alpha__Environment.Micheline.node
            Tezos_raw_protocol_alpha.Alpha_context.Script.location
            Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
            Tezos_raw_protocol_alpha.Alpha_context.Script.location *
            Tezos_protocol_environment_alpha__Environment.Micheline.annot))
        (fields :
        list
          (Tezos_protocol_environment_alpha__Environment.Micheline.node
            Tezos_raw_protocol_alpha.Alpha_context.Script.location
            Tezos_raw_protocol_alpha.Alpha_context.Script.prim))
        : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option
            (Tezos_protocol_environment_alpha__Environment.Micheline.node
              Tezos_raw_protocol_alpha.Alpha_context.Script.location
              Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
              Tezos_raw_protocol_alpha.Alpha_context.Script.location *
              Tezos_protocol_environment_alpha__Environment.Micheline.annot) *
            option
              (Tezos_protocol_environment_alpha__Environment.Micheline.node
                Tezos_raw_protocol_alpha.Alpha_context.Script.location
                Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
                Tezos_raw_protocol_alpha.Alpha_context.Script.location *
                Tezos_protocol_environment_alpha__Environment.Micheline.annot) *
            option
              (Tezos_protocol_environment_alpha__Environment.Micheline.node
                Tezos_raw_protocol_alpha.Alpha_context.Script.location
                Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
                Tezos_raw_protocol_alpha.Alpha_context.Script.location *
                Tezos_protocol_environment_alpha__Environment.Micheline.annot)) :=
        match fields with
        | [] => ok (p, s, c)
        |
          cons
            (Tezos_protocol_environment_alpha__Environment.Micheline.Int loc _)
            _ =>
          error
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              loc (cons Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind [])
              Tezos_raw_protocol_alpha.Script_tc_errors.Int_kind)
        |
          cons
            (Tezos_protocol_environment_alpha__Environment.Micheline.String loc
              _) _ =>
          error
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              loc (cons Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind [])
              Tezos_raw_protocol_alpha.Script_tc_errors.String_kind)
        |
          cons
            (Tezos_protocol_environment_alpha__Environment.Micheline.Bytes loc _)
            _ =>
          error
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              loc (cons Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind [])
              Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind)
        |
          cons
            (Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc _)
            _ =>
          error
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
              loc (cons Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind [])
              Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind)
        |
          cons
            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.K_parameter
              (cons arg []) annot) rest =>
          match p with
          | None => find_fields (Some (arg, loc, annot)) s c rest
          | Some _ =>
            error
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_field
                loc Tezos_raw_protocol_alpha.Alpha_context.Script.K_parameter)
          end
        |
          cons
            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.K_storage
              (cons arg []) annot) rest =>
          match s with
          | None => find_fields p (Some (arg, loc, annot)) c rest
          | Some _ =>
            error
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_field
                loc Tezos_raw_protocol_alpha.Alpha_context.Script.K_storage)
          end
        |
          cons
            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              Tezos_raw_protocol_alpha.Alpha_context.Script.K_code (cons arg [])
              annot) rest =>
          match c with
          | None => find_fields p s (Some (arg, loc, annot)) rest
          | Some _ =>
            error
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_field
                loc Tezos_raw_protocol_alpha.Alpha_context.Script.K_code)
          end
        |
          cons
            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              ((Tezos_raw_protocol_alpha.Alpha_context.Script.K_parameter |
                Tezos_raw_protocol_alpha.Alpha_context.Script.K_storage |
                Tezos_raw_protocol_alpha.Alpha_context.Script.K_code) as name)
              args _) _ =>
          error
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
              loc name 1 (List.length args))
        |
          cons
            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
              name _ _) _ =>
          let allowed :=
            cons Tezos_raw_protocol_alpha.Alpha_context.Script.K_parameter
              (cons Tezos_raw_protocol_alpha.Alpha_context.Script.K_storage
                (cons Tezos_raw_protocol_alpha.Alpha_context.Script.K_code []))
            in
          error
            (Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_primitive
              loc allowed name)
        end in
      op_gtgtquestion (find_fields None None None fields)
        (fun function_parameter =>
          match function_parameter with
          | (None, _, _) =>
            error
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Missing_field
                Tezos_raw_protocol_alpha.Alpha_context.Script.K_parameter)
          | (Some _, None, _) =>
            error
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Missing_field
                Tezos_raw_protocol_alpha.Alpha_context.Script.K_storage)
          | (Some _, Some _, None) =>
            error
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Missing_field
                Tezos_raw_protocol_alpha.Alpha_context.Script.K_code)
          |
            (Some (p, ploc, pannot), Some (s, sloc, sannot),
              Some (c, cloc, carrot)) =>
            let maybe_root_name :=
              op_gtgtquestion (Script_ir_annot.extract_field_annot p)
                (fun function_parameter =>
                  let '(p, root_name) := function_parameter in
                  match root_name with
                  | Some (Field_annot root_name) =>
                    ok (p, pannot, (Some root_name))
                  | None =>
                    match pannot with
                    | cons single [] =>
                      ok
                        (p, [],
                          (Some
                            (String.sub single 1
                              (op_minus (String.length single) 1))))
                    | _ => ok (p, pannot, None)
                    end
                  end) in
            if legacy then
              let '(p, root_name) :=
                match maybe_root_name with
                |
                  Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                    (p, _, root_name) => (p, root_name)
                |
                  Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                    _ => (p, None)
                end in
              ok (p, s, c, root_name)
            else
              op_gtgtquestion maybe_root_name
                (fun function_parameter =>
                  let '(p, pannot, root_name) := function_parameter in
                  op_gtgtquestion
                    (Script_ir_annot.error_unexpected_annot ploc pannot)
                    (fun function_parameter =>
                      let 'tt := function_parameter in
                      op_gtgtquestion
                        (Script_ir_annot.error_unexpected_annot cloc carrot)
                        (fun function_parameter =>
                          let 'tt := function_parameter in
                          op_gtgtquestion
                            (Script_ir_annot.error_unexpected_annot sloc sannot)
                            (fun function_parameter =>
                              let 'tt := function_parameter in
                              ok (p, s, c, root_name)))))
          end)
    end.

Definition parse_script
  (type_logger : option type_logger)
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (legacy : bool)
  (function_parameter : Tezos_raw_protocol_alpha.Alpha_context.Script.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (ex_script * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let '{| code := code; storage := storage |} := function_parameter in
  op_gtgteqquestion (Script.force_decode ctxt code)
    (fun function_parameter =>
      let '(code, ctxt) := function_parameter in
      op_gtgteqquestion (Script.force_decode ctxt storage)
        (fun function_parameter =>
          let '(storage, ctxt) := function_parameter in
          op_gtgteqquestion (op_atat Lwt.__return (parse_toplevel legacy code))
            (fun function_parameter =>
              let '(arg_type, storage_type, code_field, root_name) :=
                function_parameter in
              op_gtgteqquestion
                (trace
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
                    (Some "parameter" % string) code (location arg_type))
                  (Lwt.__return (parse_parameter_ty ctxt legacy arg_type)))
                (fun function_parameter =>
                  let '(Ex_ty arg_type, ctxt) := function_parameter in
                  op_gtgteqquestion
                    (if legacy then
                      __return tt
                    else
                      Lwt.__return (well_formed_entrypoints arg_type root_name))
                    (fun function_parameter =>
                      let 'tt := function_parameter in
                      op_gtgteqquestion
                        (trace
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
                            (Some "storage" % string) code
                            (location storage_type))
                          (Lwt.__return
                            (parse_storage_ty ctxt legacy storage_type)))
                        (fun function_parameter =>
                          let '(Ex_ty storage_type, ctxt) := function_parameter
                            in
                          let arg_annot :=
                            default_annot default_param_annot
                              (type_to_var_annot (name_of_ty arg_type)) in
                          let storage_annot :=
                            default_annot default_storage_annot
                              (type_to_var_annot (name_of_ty storage_type)) in
                          let arg_type_full :=
                            Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                              (arg_type, None, arg_annot)
                              (storage_type, None, storage_annot) None
                              (op_pipepipe (has_big_map arg_type)
                                (has_big_map storage_type)) in
                          let ret_type_full :=
                            Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                              ((Tezos_raw_protocol_alpha.Script_typed_ir.List_t
                                (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t
                                  None) None false), None, None)
                              (storage_type, None, None) None
                              (has_big_map storage_type) in
                          op_gtgteqquestion
                            (trace_eval
                              (fun function_parameter =>
                                let 'tt := function_parameter in
                                op_gtgtpipequestion
                                  (op_atat Lwt.__return
                                    (serialize_ty_for_error ctxt storage_type))
                                  (fun function_parameter =>
                                    let '(storage_type, _ctxt) :=
                                      function_parameter in
                                    Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_data
                                      None storage storage_type))
                              (parse_data type_logger ctxt legacy storage_type
                                (root storage)))
                            (fun function_parameter =>
                              let '(storage, ctxt) := function_parameter in
                              op_gtgteqquestion
                                (trace
                                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_contract
                                    code [])
                                  (parse_returning type_logger
                                    (Toplevel
                                      {| storage_type := storage_type;
                                        param_type := arg_type;
                                        root_name := root_name;
                                        legacy_create_contract_literal := false
                                        |}) ctxt legacy (arg_type_full, None)
                                    ret_type_full code_field))
                                (fun function_parameter =>
                                  let '(code, ctxt) := function_parameter in
                                  __return
                                    ((Ex_script
                                      {| code := code; arg_type := arg_type;
                                        storage := storage;
                                        storage_type := storage_type;
                                        root_name := root_name |}), ctxt))))))))).

Definition typecheck_code
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (code : Tezos_raw_protocol_alpha.Alpha_context.Script.expr)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Script_tc_errors.type_map *
        Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let legacy := false in
  op_gtgteqquestion (op_atat Lwt.__return (parse_toplevel legacy code))
    (fun function_parameter =>
      let '(arg_type, storage_type, code_field, root_name) := function_parameter
        in
      let type_map := ref [] in
      op_gtgteqquestion
        (trace
          (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
            (Some "parameter" % string) code (location arg_type))
          (Lwt.__return (parse_parameter_ty ctxt legacy arg_type)))
        (fun function_parameter =>
          let '(Ex_ty arg_type, ctxt) := function_parameter in
          op_gtgteqquestion
            (if legacy then
              __return tt
            else
              Lwt.__return (well_formed_entrypoints arg_type root_name))
            (fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteqquestion
                (trace
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
                    (Some "storage" % string) code (location storage_type))
                  (Lwt.__return (parse_storage_ty ctxt legacy storage_type)))
                (fun function_parameter =>
                  let '(Ex_ty storage_type, ctxt) := function_parameter in
                  let arg_annot :=
                    default_annot default_param_annot
                      (type_to_var_annot (name_of_ty arg_type)) in
                  let storage_annot :=
                    default_annot default_storage_annot
                      (type_to_var_annot (name_of_ty storage_type)) in
                  let arg_type_full :=
                    Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                      (arg_type, None, arg_annot)
                      (storage_type, None, storage_annot) None
                      (op_pipepipe (has_big_map arg_type)
                        (has_big_map storage_type)) in
                  let ret_type_full :=
                    Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t
                      ((Tezos_raw_protocol_alpha.Script_typed_ir.List_t
                        (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t
                          None) None false), None, None)
                      (storage_type, None, None) None (has_big_map storage_type)
                    in
                  let result :=
                    parse_returning
                      (Some
                        (fun loc =>
                          fun bef =>
                            fun aft =>
                              op_coloneq type_map
                                (cons (loc, (bef, aft))
                                  (op_exclamation type_map))))
                      (Toplevel
                        {| storage_type := storage_type; param_type := arg_type;
                          root_name := root_name;
                          legacy_create_contract_literal := false |}) ctxt
                      legacy (arg_type_full, None) ret_type_full code_field in
                  op_gtgteqquestion
                    (trace
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_contract
                        code (op_exclamation type_map)) result)
                    (fun function_parameter =>
                      let
                        '(Tezos_raw_protocol_alpha.Script_typed_ir.Lam _ _, ctxt) :=
                        function_parameter in
                      __return ((op_exclamation type_map), ctxt)))))).

Definition typecheck_data
  (type_logger : option type_logger)
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (function_parameter :
    Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Alpha_context.context) :=
  let '(data, exp_ty) := function_parameter in
  let legacy := false in
  op_gtgteqquestion
    (trace
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
        None exp_ty 0)
      (op_atat Lwt.__return (parse_packable_ty ctxt legacy (root exp_ty))))
    (fun function_parameter =>
      let '(Ex_ty exp_ty, ctxt) := function_parameter in
      op_gtgteqquestion
        (trace_eval
          (fun function_parameter =>
            let 'tt := function_parameter in
            op_gtgtpipequestion
              (op_atat Lwt.__return (serialize_ty_for_error ctxt exp_ty))
              (fun function_parameter =>
                let '(exp_ty, _ctxt) := function_parameter in
                Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_data
                  None data exp_ty))
          (parse_data type_logger ctxt legacy exp_ty (root data)))
        (fun function_parameter =>
          let '(_, ctxt) := function_parameter in
          __return ctxt)).

(* ❌ Applications of functors are not handled. *)
functor_application

Definition list_entrypoints {A : Type}
  (full : Tezos_raw_protocol_alpha.Script_typed_ir.ty A)
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (root_name :
    option
      Entrypoints_map.(Tezos_protocol_environment_alpha__Environment.MAP.S.key))
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (list (list Tezos_raw_protocol_alpha.Alpha_context.Script.prim) *
      Entrypoints_map.(Tezos_protocol_environment_alpha__Environment.MAP.S.t)
        (list Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
          Tezos_raw_protocol_alpha.Alpha_context.Script.node)) :=
  let merge {B C : Type}
    (path : list B) (annot : option variant) (ty :
    Tezos_raw_protocol_alpha.Script_typed_ir.ty C) (reachable : bool)
    (function_parameter :
    list (list B) *
      Entrypoints_map.(Tezos_protocol_environment_alpha__Environment.MAP.S.t)
        (list B * Tezos_raw_protocol_alpha.Alpha_context.Script.node))
    : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list (list B) *
        Entrypoints_map.(Tezos_protocol_environment_alpha__Environment.MAP.S.t)
          (list B * Tezos_raw_protocol_alpha.Alpha_context.Script.node)) :=
    let '(unreachables, all) as acc := function_parameter in
    match annot with
    | None | Some (Field_annot "" % string) =>
      op_atat ok
        (if reachable then
          acc
        else
          match ty with
          | Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ _ _ _ => acc
          | _ => ((cons (List.rev path) unreachables), all)
          end)
    | Some (Field_annot name) =>
      if
        Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gt)
          (String.length name) 31 then
        ok ((cons (List.rev path) unreachables), all)
      else
        if
          Entrypoints_map.(Tezos_protocol_environment_alpha__Environment.MAP.S.mem)
            name all then
          ok ((cons (List.rev path) unreachables), all)
        else
          op_gtgtquestion (unparse_ty_no_lwt ctxt ty)
            (fun function_parameter =>
              let '(unparsed_ty, _) := function_parameter in
              ok
                (unreachables,
                  (Entrypoints_map.(Tezos_protocol_environment_alpha__Environment.MAP.S.add)
                    name ((List.rev path), unparsed_ty) all)))
    end in
  let fix fold_tree {t : Type}
    (t : Tezos_raw_protocol_alpha.Script_typed_ir.ty t) (path :
    list Tezos_raw_protocol_alpha.Alpha_context.Script.prim) (reachable : bool)
    (acc :
    list (list Tezos_raw_protocol_alpha.Alpha_context.Script.prim) *
      Entrypoints_map.(Tezos_protocol_environment_alpha__Environment.MAP.S.t)
        (list Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
          Tezos_raw_protocol_alpha.Alpha_context.Script.node))
    : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list (list Tezos_raw_protocol_alpha.Alpha_context.Script.prim) *
        Entrypoints_map.(Tezos_protocol_environment_alpha__Environment.MAP.S.t)
          (list Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
            Tezos_raw_protocol_alpha.Alpha_context.Script.node)) :=
    match t with
    | Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tl, al) (tr, ar) _ _ =>
      op_gtgtquestion
        (merge (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left path)
          al tl reachable acc)
        (fun acc =>
          op_gtgtquestion
            (merge
              (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right path)
              ar tr reachable acc)
            (fun acc =>
              op_gtgtquestion
                (fold_tree tl
                  (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left
                    path)
                  match al with
                  | Some _ => true
                  | None => reachable
                  end acc)
                (fun acc =>
                  fold_tree tr
                    (cons Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right
                      path)
                    match ar with
                    | Some _ => true
                    | None => reachable
                    end acc)))
    | _ => ok acc
    end in
  op_gtgtquestion (unparse_ty_no_lwt ctxt full)
    (fun function_parameter =>
      let '(unparsed_full, _) := function_parameter in
      let '(init, reachable) :=
        match root_name with
        | None | Some "" % string =>
          (Entrypoints_map.(Tezos_protocol_environment_alpha__Environment.MAP.S.empty),
            false)
        | Some name =>
          ((Entrypoints_map.(Tezos_protocol_environment_alpha__Environment.MAP.S.singleton)
            name ([], unparsed_full)), true)
        end in
      fold_tree full [] reachable ([], init)).

Fixpoint unparse_data {a : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (mode : unparsing_mode) (ty : Tezos_raw_protocol_alpha.Script_typed_ir.ty a)
  (a : a)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.Script.node *
        Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Unparse_costs.cycle))
    (fun ctxt =>
      match (ty, a) with
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _, tt) =>
        op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Unparse_costs.unit))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                (-1) Tezos_raw_protocol_alpha.Alpha_context.Script.D_Unit [] []),
                ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _, v) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt (Unparse_costs.int v)))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Int (-1)
                (Script_int.to_zint v)), ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _, v) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt (Unparse_costs.int v)))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Int (-1)
                (Script_int.to_zint v)), ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.String_t _, s) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt (Unparse_costs.string s)))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.String
                (-1) s), ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _, s) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt (Unparse_costs.bytes s)))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                (-1) s), ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _, true) =>
        op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Unparse_costs.bool))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                (-1) Tezos_raw_protocol_alpha.Alpha_context.Script.D_True [] []),
                ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _, false) =>
        op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Unparse_costs.bool))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                (-1) Tezos_raw_protocol_alpha.Alpha_context.Script.D_False [] []),
                ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _, t) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt (Unparse_costs.timestamp t)))
          (fun ctxt =>
            match mode with
            | Optimized =>
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.Int
                  (-1) (Script_timestamp.to_zint t)), ctxt)
            | Readable =>
              match Script_timestamp.to_notation t with
              | None =>
                __return
                  ((Tezos_protocol_environment_alpha__Environment.Micheline.Int
                    (-1) (Script_timestamp.to_zint t)), ctxt)
              | Some s =>
                __return
                  ((Tezos_protocol_environment_alpha__Environment.Micheline.String
                    (-1) s), ctxt)
              end
            end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _, (c, entrypoint))
        =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Unparse_costs.contract))
          (fun ctxt =>
            match mode with
            | Optimized =>
              let entrypoint :=
                match entrypoint with
                | "default" % string => "" % string
                | name => name
                end in
              let bytes :=
                Data_encoding.Binary.to_bytes_exn
                  (tup2 Contract.encoding Variable.string) (c, entrypoint) in
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                  (-1) string), ctxt)
            | Readable =>
              let notation :=
                match entrypoint with
                | "default" % string => Contract.to_b58check c
                | entrypoint =>
                  op_caret (Contract.to_b58check c)
                    (op_caret "%" % string entrypoint)
                end in
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.String
                  (-1) notation), ctxt)
            end)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t _ _,
          (_, (c, entrypoint))) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Unparse_costs.contract))
          (fun ctxt =>
            match mode with
            | Optimized =>
              let entrypoint :=
                match entrypoint with
                | "default" % string => "" % string
                | name => name
                end in
              let bytes :=
                Data_encoding.Binary.to_bytes_exn
                  (tup2 Contract.encoding Variable.string) (c, entrypoint) in
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                  (-1) string), ctxt)
            | Readable =>
              let notation :=
                match entrypoint with
                | "default" % string => Contract.to_b58check c
                | entrypoint =>
                  op_caret (Contract.to_b58check c)
                    (op_caret "%" % string entrypoint)
                end in
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.String
                  (-1) notation), ctxt)
            end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _, s) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Unparse_costs.signature))
          (fun ctxt =>
            match mode with
            | Optimized =>
              let bytes :=
                Data_encoding.Binary.to_bytes_exn Signature.encoding s in
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                  (-1) string), ctxt)
            | Readable =>
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.String
                  (-1) (Signature.to_b58check s)), ctxt)
            end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _, v) =>
        op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Unparse_costs.tez))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Int (-1)
                (Z.of_int64 (Tez.to_mutez v))), ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _, k) =>
        op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Unparse_costs.key))
          (fun ctxt =>
            match mode with
            | Optimized =>
              let bytes :=
                Data_encoding.Binary.to_bytes_exn Signature.Public_key.encoding
                  k in
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                  (-1) string), ctxt)
            | Readable =>
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.String
                  (-1) (Signature.Public_key.to_b58check k)), ctxt)
            end)
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _, k) =>
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt Unparse_costs.key_hash))
          (fun ctxt =>
            match mode with
            | Optimized =>
              let bytes :=
                Data_encoding.Binary.to_bytes_exn
                  Signature.Public_key_hash.encoding k in
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                  (-1) string), ctxt)
            | Readable =>
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.String
                  (-1) (Signature.Public_key_hash.to_b58check k)), ctxt)
            end)
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t _,
          (op, _big_map_diff)) =>
        let bytes :=
          Data_encoding.Binary.to_bytes_exn
            Operation.internal_operation_encoding op in
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt (Unparse_costs.operation string)))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                (-1) string), ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _, chain_id) =>
        let bytes :=
          Data_encoding.Binary.to_bytes_exn
            Tezos_protocol_environment_alpha__Environment.Chain_id.(Tezos_protocol_environment_alpha__Environment.HASH.S.encoding)
            chain_id in
        op_gtgteqquestion
          (Lwt.__return (Gas.consume ctxt (Unparse_costs.chain_id string)))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Bytes
                (-1) string), ctxt))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (tl, _, _) (tr, _, _) _
          _, (l, r)) =>
        op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Unparse_costs.pair))
          (fun ctxt =>
            op_gtgteqquestion (unparse_data ctxt mode tl l)
              (fun function_parameter =>
                let '(l, ctxt) := function_parameter in
                op_gtgteqquestion (unparse_data ctxt mode tr r)
                  (fun function_parameter =>
                    let '(r, ctxt) := function_parameter in
                    __return
                      ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                        (-1)
                        Tezos_raw_protocol_alpha.Alpha_context.Script.D_Pair
                        (cons l (cons r [])) []), ctxt))))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (tl, _) _ _ _,
          Tezos_raw_protocol_alpha.Script_typed_ir.L l) =>
        op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Unparse_costs.union))
          (fun ctxt =>
            op_gtgteqquestion (unparse_data ctxt mode tl l)
              (fun function_parameter =>
                let '(l, ctxt) := function_parameter in
                __return
                  ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                    (-1) Tezos_raw_protocol_alpha.Alpha_context.Script.D_Left
                    (cons l []) []), ctxt)))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ (tr, _) _ _,
          Tezos_raw_protocol_alpha.Script_typed_ir.R r) =>
        op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Unparse_costs.union))
          (fun ctxt =>
            op_gtgteqquestion (unparse_data ctxt mode tr r)
              (fun function_parameter =>
                let '(r, ctxt) := function_parameter in
                __return
                  ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                    (-1) Tezos_raw_protocol_alpha.Alpha_context.Script.D_Right
                    (cons r []) []), ctxt)))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t t _ _, Some v) =>
        op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Unparse_costs.some))
          (fun ctxt =>
            op_gtgteqquestion (unparse_data ctxt mode t v)
              (fun function_parameter =>
                let '(v, ctxt) := function_parameter in
                __return
                  ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                    (-1) Tezos_raw_protocol_alpha.Alpha_context.Script.D_Some
                    (cons v []) []), ctxt)))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ _, None) =>
        op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Unparse_costs.none))
          (fun ctxt =>
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                (-1) Tezos_raw_protocol_alpha.Alpha_context.Script.D_None [] []),
                ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.List_t t _ _, items) =>
        op_gtgteqquestion
          (fold_left_s
            (fun function_parameter =>
              let '(l, ctxt) := function_parameter in
              fun element =>
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt Unparse_costs.list_element))
                  (fun ctxt =>
                    op_gtgteqquestion (unparse_data ctxt mode t element)
                      (fun function_parameter =>
                        let '(unparsed, ctxt) := function_parameter in
                        __return ((cons unparsed l), ctxt)))) ([], ctxt) items)
          (fun function_parameter =>
            let '(items, ctxt) := function_parameter in
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Seq (-1)
                (List.rev items)), ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t t _, set) =>
        let t := ty_of_comparable_ty t in
        op_gtgteqquestion
          (fold_left_s
            (fun function_parameter =>
              let '(l, ctxt) := function_parameter in
              fun item =>
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt Unparse_costs.set_element))
                  (fun ctxt =>
                    op_gtgteqquestion (unparse_data ctxt mode t item)
                      (fun function_parameter =>
                        let '(item, ctxt) := function_parameter in
                        __return ((cons item l), ctxt)))) ([], ctxt)
            (set_fold (fun e => fun acc => cons e acc) set []))
          (fun function_parameter =>
            let '(items, ctxt) := function_parameter in
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Seq (-1)
                items), ctxt))
      | (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t kt vt _ _, map) =>
        let kt := ty_of_comparable_ty kt in
        op_gtgteqquestion
          (fold_left_s
            (fun function_parameter =>
              let '(l, ctxt) := function_parameter in
              fun function_parameter =>
                let '(k, v) := function_parameter in
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt Unparse_costs.map_element))
                  (fun ctxt =>
                    op_gtgteqquestion (unparse_data ctxt mode kt k)
                      (fun function_parameter =>
                        let '(key, ctxt) := function_parameter in
                        op_gtgteqquestion (unparse_data ctxt mode vt v)
                          (fun function_parameter =>
                            let '(value, ctxt) := function_parameter in
                            __return
                              ((cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  (-1)
                                  Tezos_raw_protocol_alpha.Alpha_context.Script.D_Elt
                                  (cons key (cons value [])) []) l), ctxt)))))
            ([], ctxt)
            (map_fold (fun k => fun v => fun acc => cons (k, v) acc) map []))
          (fun function_parameter =>
            let '(items, ctxt) := function_parameter in
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Seq (-1)
                items), ctxt))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t kt vt _, {|
          id := None; diff := Diff |}) =>
        let Diff := projT2 Diff in
        let kt := ty_of_comparable_ty kt in
        op_gtgteqquestion
          (fold_left_s
            (fun function_parameter =>
              let '(l, ctxt) := function_parameter in
              fun function_parameter =>
                let '(k, v) := function_parameter in
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt Unparse_costs.map_element))
                  (fun ctxt =>
                    op_gtgteqquestion (unparse_data ctxt mode kt k)
                      (fun function_parameter =>
                        let '(key, ctxt) := function_parameter in
                        op_gtgteqquestion (unparse_data ctxt mode vt v)
                          (fun function_parameter =>
                            let '(value, ctxt) := function_parameter in
                            __return
                              ((cons
                                (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                                  (-1)
                                  Tezos_raw_protocol_alpha.Alpha_context.Script.D_Elt
                                  (cons key (cons value [])) []) l), ctxt)))))
            ([], ctxt)
            (Diff.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.fold)
              (fun k =>
                fun v =>
                  fun acc =>
                    match v with
                    | None => acc
                    | Some v => cons (k, v) acc
                    end)
              (fst
                Diff.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed))
              []))
          (fun function_parameter =>
            let '(items, ctxt) := function_parameter in
            __return
              ((Tezos_protocol_environment_alpha__Environment.Micheline.Seq (-1)
                items), ctxt))
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t _kt _kv _, {|
          id := Some id; diff := Diff |}) =>
        let Diff := projT2 Diff in
        if
          Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
            (Diff.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.cardinal)
              (fst
                Diff.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed)))
            0 then
          __return
            ((Tezos_protocol_environment_alpha__Environment.Micheline.Int (-1)
              id), ctxt)
        else
          (* ❌ Assert instruction is not handled. *)
          assert false
      |
        (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t _ _ _,
          Tezos_raw_protocol_alpha.Script_typed_ir.Lam _ original_code) =>
        unparse_code ctxt mode original_code
      end)

with unparse_code
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (mode : unparsing_mode)
  : Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_protocol_environment_alpha__Environment.Micheline.node Z
          Tezos_raw_protocol_alpha.Alpha_context.Script.prim *
          Tezos_raw_protocol_alpha__Alpha_context.context)) :=
  let legacy := true in
  fun function_parameter =>
    match function_parameter with
    |
      Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc
        Tezos_raw_protocol_alpha.Alpha_context.Script.I_PUSH
        (cons ty (cons data [])) annot =>
      op_gtgteqquestion (Lwt.__return (parse_packable_ty ctxt legacy ty))
        (fun function_parameter =>
          let '(Ex_ty t, ctxt) := function_parameter in
          op_gtgteqquestion (parse_data None ctxt legacy t data)
            (fun function_parameter =>
              let '(data, ctxt) := function_parameter in
              op_gtgteqquestion (unparse_data ctxt mode t data)
                (fun function_parameter =>
                  let '(data, ctxt) := function_parameter in
                  op_gtgteqquestion
                    (Lwt.__return
                      (Gas.consume ctxt (Unparse_costs.prim_cost 2 annot)))
                    (fun ctxt =>
                      __return
                        ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          loc
                          Tezos_raw_protocol_alpha.Alpha_context.Script.I_PUSH
                          (cons ty (cons data [])) annot), ctxt)))))
    | Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc items =>
      op_gtgteqquestion
        (fold_left_s
          (fun function_parameter =>
            let '(l, ctxt) := function_parameter in
            fun item =>
              op_gtgteqquestion (unparse_code ctxt mode item)
                (fun function_parameter =>
                  let '(item, ctxt) := function_parameter in
                  __return ((cons item l), ctxt))) ([], ctxt) items)
        (fun function_parameter =>
          let '(items, ctxt) := function_parameter in
          op_gtgteqquestion
            (Lwt.__return
              (Gas.consume ctxt (Unparse_costs.seq_cost (List.length items))))
            (fun ctxt =>
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                  loc (List.rev items)), ctxt)))
    |
      Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc prim
        items annot =>
      op_gtgteqquestion
        (fold_left_s
          (fun function_parameter =>
            let '(l, ctxt) := function_parameter in
            fun item =>
              op_gtgteqquestion (unparse_code ctxt mode item)
                (fun function_parameter =>
                  let '(item, ctxt) := function_parameter in
                  __return ((cons item l), ctxt))) ([], ctxt) items)
        (fun function_parameter =>
          let '(items, ctxt) := function_parameter in
          op_gtgteqquestion
            (Lwt.__return (Gas.consume ctxt (Unparse_costs.prim_cost 3 annot)))
            (fun ctxt =>
              __return
                ((Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                  loc prim (List.rev items) annot), ctxt)))
    |
      (Tezos_protocol_environment_alpha__Environment.Micheline.Int _ _ |
        Tezos_protocol_environment_alpha__Environment.Micheline.String _ _ |
        Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ _) as
        atom => __return (atom, ctxt)
    end.

Definition unparse_script {A B : Type}
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (mode : unparsing_mode)
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.script A B)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.Script.t *
        Tezos_raw_protocol_alpha__Alpha_context.context)) :=
  let '{|
    code := code;
      arg_type := arg_type;
      storage := storage;
      storage_type := storage_type;
      root_name := root_name
      |} := function_parameter in
  let 'Tezos_raw_protocol_alpha.Script_typed_ir.Lam _ original_code := code in
  op_gtgteqquestion (unparse_code ctxt mode original_code)
    (fun function_parameter =>
      let '(code, ctxt) := function_parameter in
      op_gtgteqquestion (unparse_data ctxt mode storage_type storage)
        (fun function_parameter =>
          let '(storage, ctxt) := function_parameter in
          op_gtgteqquestion (unparse_ty ctxt arg_type)
            (fun function_parameter =>
              let '(arg_type, ctxt) := function_parameter in
              op_gtgteqquestion (unparse_ty ctxt storage_type)
                (fun function_parameter =>
                  let '(storage_type, ctxt) := function_parameter in
                  let arg_type :=
                    add_field_annot
                      (Option.map
                        (fun n =>
                          (* ❌ Variants not supported *)
                          variant) root_name) None arg_type in
                  let code :=
                    Tezos_protocol_environment_alpha__Environment.Micheline.Seq
                      (-1)
                      (cons
                        (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                          (-1)
                          Tezos_raw_protocol_alpha.Alpha_context.Script.K_parameter
                          (cons arg_type []) [])
                        (cons
                          (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                            (-1)
                            Tezos_raw_protocol_alpha.Alpha_context.Script.K_storage
                            (cons storage_type []) [])
                          (cons
                            (Tezos_protocol_environment_alpha__Environment.Micheline.Prim
                              (-1)
                              Tezos_raw_protocol_alpha.Alpha_context.Script.K_code
                              (cons code []) []) []))) in
                  op_gtgteqquestion
                    (Lwt.__return
                      (op_gtgtquestion
                        (Gas.consume ctxt (Unparse_costs.seq_cost 3))
                        (fun ctxt =>
                          op_gtgtquestion
                            (Gas.consume ctxt (Unparse_costs.prim_cost 1 []))
                            (fun ctxt =>
                              op_gtgtquestion
                                (Gas.consume ctxt (Unparse_costs.prim_cost 1 []))
                                (fun ctxt =>
                                  Gas.consume ctxt
                                    (Unparse_costs.prim_cost 1 []))))))
                    (fun ctxt =>
                      __return
                        ({| code := lazy_expr (strip_locations code);
                          storage := lazy_expr (strip_locations storage) |},
                          ctxt)))))).

Definition pack_data {A : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (typ : Tezos_raw_protocol_alpha.Script_typed_ir.ty A) (data : A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.MBytes.t *
        Tezos_raw_protocol_alpha__Alpha_context.context)) :=
  op_gtgteqquestion (unparse_data ctxt Optimized typ data)
    (fun function_parameter =>
      let '(unparsed, ctxt) := function_parameter in
      let bytes :=
        Data_encoding.Binary.to_bytes_exn expr_encoding
          (Micheline.strip_locations unparsed) in
      op_gtgteqquestion
        (op_atat Lwt.__return (Gas.consume ctxt (Script.serialized_cost string)))
        (fun ctxt =>
          let bytes :=
            MBytes.concat "" % string
              (cons (MBytes.of_string "" % string) (cons string [])) in
          op_gtgteqquestion
            (op_atat Lwt.__return
              (Gas.consume ctxt (Script.serialized_cost string)))
            (fun ctxt => __return (string, ctxt)))).

Definition hash_data {A : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (typ : Tezos_raw_protocol_alpha.Script_typed_ir.ty A) (data : A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Script_expr_hash.t *
        Tezos_raw_protocol_alpha__Alpha_context.context)) :=
  op_gtgteqquestion (pack_data ctxt typ data)
    (fun function_parameter =>
      let '(bytes, ctxt) := function_parameter in
      op_gtgteqquestion
        (op_atat Lwt.__return
          (Gas.consume ctxt
            (Michelson_v1_gas.Cost_of.Legacy.hash string Script_expr_hash.size)))
        (fun ctxt => __return ((hash_bytes None (cons string [])), ctxt))).

Definition empty_big_map {A B : Type}
  (tk : Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty A)
  (tv : Tezos_raw_protocol_alpha.Script_typed_ir.ty B)
  : Tezos_raw_protocol_alpha.Script_typed_ir.big_map A B :=
  {| id := None; diff := empty_map tk; key_type := ty_of_comparable_ty tk;
    value_type := tv |}.

Definition big_map_mem {A B : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (key : A)
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.big_map A B)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (bool * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let '{| id := id; diff := diff; key_type := key_type |} := function_parameter
    in
  match ((map_get key diff), id) with
  | (None, None) => __return (false, ctxt)
  | (None, Some id) =>
    op_gtgteqquestion (hash_data ctxt key_type key)
      (fun function_parameter =>
        let '(hash, ctxt) := function_parameter in
        op_gtgteqquestion (Alpha_context.Big_map.mem ctxt id hash)
          (fun function_parameter =>
            let '(ctxt, res) := function_parameter in
            __return (res, ctxt)))
  | (Some None, _) => __return (false, ctxt)
  | (Some (Some _), _) => __return (true, ctxt)
  end.

Definition big_map_get {A B : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (key : A)
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.big_map A B)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (option B * Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let '{|
    id := id;
      diff := diff;
      key_type := key_type;
      value_type := value_type
      |} := function_parameter in
  match ((map_get key diff), id) with
  | (Some x, _) => __return (x, ctxt)
  | (None, None) => __return (None, ctxt)
  | (None, Some id) =>
    op_gtgteqquestion (hash_data ctxt key_type key)
      (fun function_parameter =>
        let '(hash, ctxt) := function_parameter in
        op_gtgteqquestion (Alpha_context.Big_map.get_opt ctxt id hash)
          (fun function_parameter =>
            match function_parameter with
            | (ctxt, None) => __return (None, ctxt)
            | (ctxt, Some value) =>
              op_gtgteqquestion
                (parse_data None ctxt true value_type (Micheline.root value))
                (fun function_parameter =>
                  let '(x, ctxt) := function_parameter in
                  __return ((Some x), ctxt))
            end))
  end.

Definition big_map_update {A B : Type}
  (key : A) (value : option B)
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.big_map A B)
  : Tezos_raw_protocol_alpha.Script_typed_ir.big_map A B :=
  let '{| diff := diff |} as map := function_parameter in
  (* ❌ Record substitution not handled *)
  record_substitution.

(* ❌ Applications of functors are not handled. *)
functor_application

Definition big_map_ids :=
  Ids.(Tezos_protocol_environment_alpha__Environment.SET.S.t).

Definition no_big_map_id
  : Ids.(Tezos_protocol_environment_alpha__Environment.SET.S.t) :=
  Ids.(Tezos_protocol_environment_alpha__Environment.SET.S.empty).

Definition diff_of_big_map {A B : Type}
  (ctxt : Tezos_raw_protocol_alpha__Alpha_context.context)
  (fresh :
    Tezos_raw_protocol_alpha__Alpha_context.context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha__Alpha_context.context *
            Tezos_raw_protocol_alpha__Alpha_context.Big_map.id)))
  (mode : unparsing_mode)
  (ids : Ids.(Tezos_protocol_environment_alpha__Environment.SET.S.t))
  (function_parameter : Tezos_raw_protocol_alpha.Script_typed_ir.big_map A B)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff_item *
        Tezos_raw_protocol_alpha__Alpha_context.Big_map.id *
        Tezos_raw_protocol_alpha__Alpha_context.context)) :=
  let '{|
    id := id;
      diff := diff;
      key_type := key_type;
      value_type := value_type
      |} := function_parameter in
  op_gtgteqquestion
    (Lwt.__return
      (Gas.consume ctxt (Michelson_v1_gas.Cost_of.Legacy.map_to_list diff)))
    (fun ctxt =>
      op_gtgteqquestion
        match id with
        | Some id =>
          if
            Ids.(Tezos_protocol_environment_alpha__Environment.SET.S.mem) id ids
            then
            op_gtgteqquestion (fresh ctxt)
              (fun function_parameter =>
                let '(ctxt, duplicate) := function_parameter in
                __return
                  (ctxt,
                    (cons
                      (Tezos_raw_protocol_alpha.Alpha_context.Contract.Copy id
                        duplicate) []), duplicate))
          else
            __return (ctxt, [], id)
        | None =>
          op_gtgteqquestion (fresh ctxt)
            (fun function_parameter =>
              let '(ctxt, id) := function_parameter in
              op_gtgteqquestion (unparse_ty ctxt key_type)
                (fun function_parameter =>
                  let '(kt, ctxt) := function_parameter in
                  op_gtgteqquestion (unparse_ty ctxt value_type)
                    (fun function_parameter =>
                      let '(kv, ctxt) := function_parameter in
                      __return
                        (ctxt,
                          (cons
                            (Tezos_raw_protocol_alpha.Alpha_context.Contract.Alloc
                              {| big_map := id;
                                key_type := Micheline.strip_locations kt;
                                value_type := Micheline.strip_locations kv |})
                            []), id))))
        end
        (fun function_parameter =>
          let '(ctxt, init, big_map) := function_parameter in
          let pairs :=
            map_fold (fun key => fun value => fun acc => cons (key, value) acc)
              diff [] in
          op_gtgteqquestion
            (fold_left_s
              (fun function_parameter =>
                let '(acc, ctxt) := function_parameter in
                fun function_parameter =>
                  let '(key, value) := function_parameter in
                  op_gtgteqquestion
                    (Lwt.__return (Gas.consume ctxt Typecheck_costs.cycle))
                    (fun ctxt =>
                      op_gtgteqquestion (hash_data ctxt key_type key)
                        (fun function_parameter =>
                          let '(diff_key_hash, ctxt) := function_parameter in
                          op_gtgteqquestion
                            (unparse_data ctxt mode key_type key)
                            (fun function_parameter =>
                              let '(key_node, ctxt) := function_parameter in
                              let diff_key := Micheline.strip_locations key_node
                                in
                              op_gtgteqquestion
                                match value with
                                | None => __return (None, ctxt)
                                | Some x =>
                                  op_gtgteqquestion
                                    (unparse_data ctxt mode value_type x)
                                    (fun function_parameter =>
                                      let '(node, ctxt) := function_parameter in
                                      __return
                                        ((Some (Micheline.strip_locations node)),
                                          ctxt))
                                end
                                (fun function_parameter =>
                                  let '(diff_value, ctxt) := function_parameter
                                    in
                                  let diff_item :=
                                    Tezos_raw_protocol_alpha.Alpha_context.Contract.Update
                                      {| big_map := big_map;
                                        diff_key := diff_key;
                                        diff_key_hash := diff_key_hash;
                                        diff_value := diff_value |} in
                                  __return ((cons diff_item acc), ctxt))))))
              ([], ctxt) pairs)
            (fun function_parameter =>
              let '(diff, ctxt) := function_parameter in
              __return ((op_at init diff), big_map, ctxt)))).

Fixpoint extract_big_map_updates {a : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (fresh :
    Tezos_raw_protocol_alpha.Alpha_context.context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Alpha_context.context *
            Tezos_raw_protocol_alpha.Alpha_context.Big_map.id)))
  (mode : unparsing_mode)
  (ids : Ids.(Tezos_protocol_environment_alpha__Environment.SET.S.t))
  (acc : list Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff)
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.ty a) (x : a)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.context * a *
        Ids.(Tezos_protocol_environment_alpha__Environment.SET.S.t) *
        list Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff)) :=
  match (ty, x) with
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t _ _ _, map) =>
    op_gtgteqquestion (diff_of_big_map ctxt fresh mode ids map)
      (fun function_parameter =>
        let '(diff, id, ctxt) := function_parameter in
        let Map := diff map in
        let Map := projT2 Map in
        let map :=
          (* ❌ Record substitution not handled *)
          record_substitution in
        __return
          (ctxt, map,
            (Ids.(Tezos_protocol_environment_alpha__Environment.SET.S.add) id
              ids), (cons diff acc)))
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (tyl, _, _) (tyr, _, _) _
      true, (xl, xr)) =>
    op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Typecheck_costs.cycle))
      (fun ctxt =>
        op_gtgteqquestion
          (extract_big_map_updates ctxt fresh mode ids acc tyl xl)
          (fun function_parameter =>
            let '(ctxt, xl, ids, acc) := function_parameter in
            op_gtgteqquestion
              (extract_big_map_updates ctxt fresh mode ids acc tyr xr)
              (fun function_parameter =>
                let '(ctxt, xr, ids, acc) := function_parameter in
                __return (ctxt, (xl, xr), ids, acc))))
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (ty, _) (_, _) _ true,
      Tezos_raw_protocol_alpha.Script_typed_ir.L x) =>
    op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Typecheck_costs.cycle))
      (fun ctxt =>
        op_gtgteqquestion (extract_big_map_updates ctxt fresh mode ids acc ty x)
          (fun function_parameter =>
            let '(ctxt, x, ids, acc) := function_parameter in
            __return
              (ctxt, (Tezos_raw_protocol_alpha.Script_typed_ir.L x), ids, acc)))
  |
    (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (_, _) (ty, _) _ true,
      Tezos_raw_protocol_alpha.Script_typed_ir.R x) =>
    op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Typecheck_costs.cycle))
      (fun ctxt =>
        op_gtgteqquestion (extract_big_map_updates ctxt fresh mode ids acc ty x)
          (fun function_parameter =>
            let '(ctxt, x, ids, acc) := function_parameter in
            __return
              (ctxt, (Tezos_raw_protocol_alpha.Script_typed_ir.R x), ids, acc)))
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t ty _ true, Some x) =>
    op_gtgteqquestion (Lwt.__return (Gas.consume ctxt Typecheck_costs.cycle))
      (fun ctxt =>
        op_gtgteqquestion (extract_big_map_updates ctxt fresh mode ids acc ty x)
          (fun function_parameter =>
            let '(ctxt, x, ids, acc) := function_parameter in
            __return (ctxt, (Some x), ids, acc)))
  | (Tezos_raw_protocol_alpha.Script_typed_ir.List_t ty _ true, l) =>
    op_gtgteqquestion
      (fold_left_s
        (fun function_parameter =>
          let '(ctxt, l, ids, acc) := function_parameter in
          fun x =>
            op_gtgteqquestion
              (Lwt.__return (Gas.consume ctxt Typecheck_costs.cycle))
              (fun ctxt =>
                op_gtgteqquestion
                  (extract_big_map_updates ctxt fresh mode ids acc ty x)
                  (fun function_parameter =>
                    let '(ctxt, x, ids, acc) := function_parameter in
                    __return (ctxt, (cons x l), ids, acc))))
        (ctxt, [], ids, acc) l)
      (fun function_parameter =>
        let '(ctxt, l, ids, acc) := function_parameter in
        __return (ctxt, (List.rev l), ids, acc))
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t _ ty _ true, M as m) =>
    let M := projT2 M in
    op_gtgteqquestion
      (Lwt.__return
        (Gas.consume ctxt (Michelson_v1_gas.Cost_of.Legacy.map_to_list m)))
      (fun ctxt =>
        op_gtgteqquestion
          (fold_left_s
            (fun function_parameter =>
              let '(ctxt, m, ids, acc) := function_parameter in
              fun function_parameter =>
                let '(k, x) := function_parameter in
                op_gtgteqquestion
                  (Lwt.__return (Gas.consume ctxt Typecheck_costs.cycle))
                  (fun ctxt =>
                    op_gtgteqquestion
                      (extract_big_map_updates ctxt fresh mode ids acc ty x)
                      (fun function_parameter =>
                        let '(ctxt, x, ids, acc) := function_parameter in
                        __return
                          (ctxt,
                            (M.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.add)
                              k x m), ids, acc))))
            (ctxt,
              M.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.empty),
              ids, acc)
            (M.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS).(Tezos_protocol_environment_alpha__Environment.MAP.S.bindings)
              (fst M.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed))))
          (fun function_parameter =>
            let '(ctxt, m, ids, acc) := function_parameter in
            let M :=
              (* ❌ The signature name of this module could not be found *)
              existT _ _
                {|
                  unknown_signature_name.OPS :=
                    M.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.OPS);
                  unknown_signature_name.key_ty :=
                    M.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.key_ty);
                  unknown_signature_name.boxed :=
                    (m,
                      (snd
                        M.(Tezos_raw_protocol_alpha.Script_typed_ir.Boxed_map.boxed)))
                  |} in
            __return (ctxt, M, ids, acc)))
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ true, None) =>
    __return (ctxt, None, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.List_t _ _ false, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t _ _ _ false, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ false, None) =>
    __return (ctxt, None, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t _ _ _ false, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ _ _ false, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ false, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t _ _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.String_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t _ _ _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t _ _, v) =>
    __return (ctxt, v, ids, acc)
  | (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t _, _) =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  end.

Definition collect_big_maps {A : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.ty A) (x : A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Ids.(Tezos_protocol_environment_alpha__Environment.SET.S.t) *
        Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let fix collect {a : Type}
    (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context) (ty :
    Tezos_raw_protocol_alpha.Script_typed_ir.ty a) (x : a) (acc :
    Ids.(Tezos_protocol_environment_alpha__Environment.SET.S.t))
    : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Ids.(Tezos_protocol_environment_alpha__Environment.SET.S.t) *
        Tezos_raw_protocol_alpha.Alpha_context.context) :=
    match (ty, x) with
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t _ _ _, {|
        id := Some id |}) =>
      op_gtgtquestion (Gas.consume ctxt Typecheck_costs.cycle)
        (fun ctxt =>
          ok
            ((Ids.(Tezos_protocol_environment_alpha__Environment.SET.S.add) id
              acc), ctxt))
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t (tyl, _, _) (tyr, _, _) _
        true, (xl, xr)) =>
      op_gtgtquestion (collect ctxt tyl xl acc)
        (fun function_parameter =>
          let '(acc, ctxt) := function_parameter in
          collect ctxt tyr xr acc)
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (ty, _) (_, _) _ true,
        Tezos_raw_protocol_alpha.Script_typed_ir.L x) => collect ctxt ty x acc
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t (_, _) (ty, _) _ true,
        Tezos_raw_protocol_alpha.Script_typed_ir.R x) => collect ctxt ty x acc
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t ty _ true, Some x) =>
      collect ctxt ty x acc
    | (Tezos_raw_protocol_alpha.Script_typed_ir.List_t ty _ true, l) =>
      List.fold_left
        (fun acc =>
          fun x =>
            op_gtgtquestion acc
              (fun function_parameter =>
                let '(acc, ctxt) := function_parameter in
                collect ctxt ty x acc)) (ok (acc, ctxt)) l
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t _ ty _ true, m) =>
      map_fold
        (fun function_parameter =>
          let '_ := function_parameter in
          fun v =>
            fun acc =>
              op_gtgtquestion acc
                (fun function_parameter =>
                  let '(acc, ctxt) := function_parameter in
                  collect ctxt ty v acc)) m (ok (acc, ctxt))
    | (Tezos_raw_protocol_alpha.Script_typed_ir.List_t _ _ false, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Map_t _ _ _ false, _) =>
      ok (acc, ctxt)
    |
      (Tezos_raw_protocol_alpha.Script_typed_ir.Big_map_t _ _ _, {|
        id := None |}) => ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ true, None) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Option_t _ _ false, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Union_t _ _ _ false, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Pair_t _ _ _ false, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Chain_id_t _, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Set_t _ _, _) => ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Unit_t _, _) => ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Int_t _, _) => ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Nat_t _, _) => ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Signature_t _, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.String_t _, _) => ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Bytes_t _, _) => ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Mutez_t _, _) => ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Key_hash_t _, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Key_t _, _) => ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Timestamp_t _, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Address_t _, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Bool_t _, _) => ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Lambda_t _ _ _, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Contract_t _ _, _) =>
      ok (acc, ctxt)
    | (Tezos_raw_protocol_alpha.Script_typed_ir.Operation_t _, _) =>
      (* ❌ Assert instruction is not handled. *)
      assert false
    end in
  Lwt.__return (collect ctxt ty x no_big_map_id).

Definition extract_big_map_diff {A : Type}
  (ctxt : Tezos_raw_protocol_alpha.Alpha_context.context)
  (mode : unparsing_mode) (temporary : bool)
  (to_duplicate : Ids.(Tezos_protocol_environment_alpha__Environment.SET.S.t))
  (to_update : Ids.(Tezos_protocol_environment_alpha__Environment.SET.S.t))
  (ty : Tezos_raw_protocol_alpha.Script_typed_ir.ty A) (v : A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (A *
        option
          (list
            Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff_item) *
        Tezos_raw_protocol_alpha.Alpha_context.context)) :=
  let to_duplicate :=
    Ids.(Tezos_protocol_environment_alpha__Environment.SET.S.diff) to_duplicate
      to_update in
  let fresh :=
    if temporary then
      fun c => __return (Big_map.fresh_temporary c)
    else
      Big_map.fresh in
  op_gtgteqquestion
    (extract_big_map_updates ctxt fresh mode to_duplicate [] ty v)
    (fun function_parameter =>
      let '(ctxt, v, alive, diffs) := function_parameter in
      let diffs :=
        if temporary then
          diffs
        else
          let dead :=
            Ids.(Tezos_protocol_environment_alpha__Environment.SET.S.diff)
              to_update alive in
          cons
            (Ids.(Tezos_protocol_environment_alpha__Environment.SET.S.fold)
              (fun id =>
                fun acc =>
                  cons
                    (Tezos_raw_protocol_alpha.Alpha_context.Contract.Clear id)
                    acc) dead []) diffs in
      match diffs with
      | [] => __return (v, None, ctxt)
      | diffs => __return (v, (Some (List.flatten diffs)), ctxt)
      end).

Definition list_of_big_map_ids
  (ids : Ids.(Tezos_protocol_environment_alpha__Environment.SET.S.t))
  : list Ids.(Tezos_protocol_environment_alpha__Environment.SET.S.elt) :=
  Ids.(Tezos_protocol_environment_alpha__Environment.SET.S.elements) ids.
script_ir_translator.mli 8 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Script_tc_errors

type ('ta, 'tb) eq = Eq : ('same, 'same) eq

type ex_comparable_ty =
  | Ex_comparable_ty : 'a Script_typed_ir.comparable_ty -> ex_comparable_ty

type ex_ty = Ex_ty : 'a Script_typed_ir.ty -> ex_ty

type ex_stack_ty = Ex_stack_ty : 'a Script_typed_ir.stack_ty -> ex_stack_ty

type ex_script = Ex_script : ('a, 'b) Script_typed_ir.script -> ex_script

type tc_context =
  | Lambda : tc_context
  | Dip : 'a Script_typed_ir.stack_ty * tc_context -> tc_context
  | Toplevel : {
      storage_type : 'sto Script_typed_ir.ty;
      param_type : 'param Script_typed_ir.ty;
      root_name : string option;
      legacy_create_contract_literal : bool;
    }
      -> tc_context

type 'bef judgement =
  | Typed : ('bef, 'aft) Script_typed_ir.descr -> 'bef judgement
  | Failed : {
      descr :
        'aft. 'aft Script_typed_ir.stack_ty ->
        ('bef, 'aft) Script_typed_ir.descr;
    }
      -> 'bef judgement

type unparsing_mode = Optimized | Readable

type type_logger =
  int ->
  (Script.expr * Script.annot) list ->
  (Script.expr * Script.annot) list ->
  unit

(* ---- Sets and Maps -------------------------------------------------------*)

val empty_set : 'a Script_typed_ir.comparable_ty -> 'a Script_typed_ir.set

val set_fold :
  ('elt -> 'acc -> 'acc) -> 'elt Script_typed_ir.set -> 'acc -> 'acc

val set_update : 'a -> bool -> 'a Script_typed_ir.set -> 'a Script_typed_ir.set

val set_mem : 'elt -> 'elt Script_typed_ir.set -> bool

val set_size : 'elt Script_typed_ir.set -> Script_int.n Script_int.num

val empty_map :
  'a Script_typed_ir.comparable_ty -> ('a, 'b) Script_typed_ir.map

val map_fold :
  ('key -> 'value -> 'acc -> 'acc) ->
  ('key, 'value) Script_typed_ir.map ->
  'acc ->
  'acc

val map_update :
  'a ->
  'b option ->
  ('a, 'b) Script_typed_ir.map ->
  ('a, 'b) Script_typed_ir.map

val map_mem : 'key -> ('key, 'value) Script_typed_ir.map -> bool

val map_get : 'key -> ('key, 'value) Script_typed_ir.map -> 'value option

val map_key_ty :
  ('a, 'b) Script_typed_ir.map -> 'a Script_typed_ir.comparable_ty

val map_size : ('a, 'b) Script_typed_ir.map -> Script_int.n Script_int.num

val empty_big_map :
  'a Script_typed_ir.comparable_ty ->
  'b Script_typed_ir.ty ->
  ('a, 'b) Script_typed_ir.big_map

val big_map_mem :
  context ->
  'key ->
  ('key, 'value) Script_typed_ir.big_map ->
  (bool * context) tzresult Lwt.t

val big_map_get :
  context ->
  'key ->
  ('key, 'value) Script_typed_ir.big_map ->
  ('value option * context) tzresult Lwt.t

val big_map_update :
  'key ->
  'value option ->
  ('key, 'value) Script_typed_ir.big_map ->
  ('key, 'value) Script_typed_ir.big_map

val ty_eq :
  context ->
  'ta Script_typed_ir.ty ->
  'tb Script_typed_ir.ty ->
  (('ta Script_typed_ir.ty, 'tb Script_typed_ir.ty) eq * context) tzresult

val compare_comparable : 'a Script_typed_ir.comparable_ty -> 'a -> 'a -> int

val parse_data :
  ?type_logger:type_logger ->
  context ->
  legacy:bool ->
  'a Script_typed_ir.ty ->
  Script.node ->
  ('a * context) tzresult Lwt.t

val unparse_data :
  context ->
  unparsing_mode ->
  'a Script_typed_ir.ty ->
  'a ->
  (Script.node * context) tzresult Lwt.t

val parse_instr :
  ?type_logger:type_logger ->
  tc_context ->
  context ->
  legacy:bool ->
  Script.node ->
  'bef Script_typed_ir.stack_ty ->
  ('bef judgement * context) tzresult Lwt.t

val parse_ty :
  context ->
  legacy:bool ->
  allow_big_map:bool ->
  allow_operation:bool ->
  allow_contract:bool ->
  Script.node ->
  (ex_ty * context) tzresult

val parse_packable_ty :
  context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult

val unparse_ty :
  context -> 'a Script_typed_ir.ty -> (Script.node * context) tzresult Lwt.t

val parse_toplevel :
  legacy:bool ->
  Script.expr ->
  (Script.node * Script.node * Script.node * string option) tzresult

val add_field_annot :
  [`Field_annot of string] option ->
  [`Var_annot of string] option ->
  Script.node ->
  Script.node

val typecheck_code :
  context -> Script.expr -> (type_map * context) tzresult Lwt.t

val typecheck_data :
  ?type_logger:type_logger ->
  context ->
  Script.expr * Script.expr ->
  context tzresult Lwt.t

val parse_script :
  ?type_logger:type_logger ->
  context ->
  legacy:bool ->
  Script.t ->
  (ex_script * context) tzresult Lwt.t

(* Gas accounting may not be perfect in this function, as it is only called by RPCs. *)
val unparse_script :
  context ->
  unparsing_mode ->
  ('a, 'b) Script_typed_ir.script ->
  (Script.t * context) tzresult Lwt.t

val parse_contract :
  legacy:bool ->
  context ->
  Script.location ->
  'a Script_typed_ir.ty ->
  Contract.t ->
  entrypoint:string ->
  (context * 'a Script_typed_ir.typed_contract) tzresult Lwt.t

val parse_contract_for_script :
  legacy:bool ->
  context ->
  Script.location ->
  'a Script_typed_ir.ty ->
  Contract.t ->
  entrypoint:string ->
  (context * 'a Script_typed_ir.typed_contract option) tzresult Lwt.t

val find_entrypoint :
  't Script_typed_ir.ty ->
  root_name:string option ->
  string ->
  ((Script.node -> Script.node) * ex_ty) tzresult

module Entrypoints_map : S.MAP with type key = string

val list_entrypoints :
  't Script_typed_ir.ty ->
  context ->
  root_name:string option ->
  ( Michelson_v1_primitives.prim list list
  * (Michelson_v1_primitives.prim list * Script.node) Entrypoints_map.t )
  tzresult

val pack_data :
  context -> 'a Script_typed_ir.ty -> 'a -> (MBytes.t * context) tzresult Lwt.t

val hash_data :
  context ->
  'a Script_typed_ir.ty ->
  'a ->
  (Script_expr_hash.t * context) tzresult Lwt.t

type big_map_ids

val no_big_map_id : big_map_ids

val collect_big_maps :
  context ->
  'a Script_typed_ir.ty ->
  'a ->
  (big_map_ids * context) tzresult Lwt.t

val list_of_big_map_ids : big_map_ids -> Z.t list

val extract_big_map_diff :
  context ->
  unparsing_mode ->
  temporary:bool ->
  to_duplicate:big_map_ids ->
  to_update:big_map_ids ->
  'a Script_typed_ir.ty ->
  'a ->
  ('a * Contract.big_map_diff option * context) tzresult Lwt.t
script_ir_translator_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Reserved Notation "'eq".

Inductive eq_gadt : Type :=
| Eq : eq_gadt

where "'eq" := (fun (ta tb : Type) => eq_gadt).

Definition eq := 'eq.

Reserved Notation "'ex_comparable_ty".

Inductive ex_comparable_ty_gadt : Type :=
| Ex_comparable_ty : forall {a : Type},
  Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a ->
  ex_comparable_ty_gadt

where "'ex_comparable_ty" := (ex_comparable_ty_gadt).

Definition ex_comparable_ty := 'ex_comparable_ty.

Reserved Notation "'ex_ty".

Inductive ex_ty_gadt : Type :=
| Ex_ty : forall {a : Type}, Tezos_raw_protocol_alpha.Script_typed_ir.ty a ->
  ex_ty_gadt

where "'ex_ty" := (ex_ty_gadt).

Definition ex_ty := 'ex_ty.

Reserved Notation "'ex_stack_ty".

Inductive ex_stack_ty_gadt : Type :=
| Ex_stack_ty : forall {a : Type},
  Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty a -> ex_stack_ty_gadt

where "'ex_stack_ty" := (ex_stack_ty_gadt).

Definition ex_stack_ty := 'ex_stack_ty.

Reserved Notation "'ex_script".

Inductive ex_script_gadt : Type :=
| Ex_script : forall {a b : Type},
  Tezos_raw_protocol_alpha.Script_typed_ir.script a b -> ex_script_gadt

where "'ex_script" := (ex_script_gadt).

Definition ex_script := 'ex_script.

Reserved Notation "'tc_context".

Inductive tc_context_gadt : Type :=
| Lambda : tc_context_gadt
| Dip : forall {a : Type}, Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty a
  -> tc_context_gadt -> tc_context_gadt
| Toplevel : forall {param sto : Type},
  Tezos_raw_protocol_alpha.Script_typed_ir.ty sto ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty param -> option string -> bool ->
  tc_context_gadt

where "'tc_context" := (tc_context_gadt).

Definition tc_context := 'tc_context.

Reserved Notation "'judgement".

Inductive judgement_gadt : Type :=
| Typed : forall {aft bef : Type},
  Tezos_raw_protocol_alpha.Script_typed_ir.descr bef aft -> judgement_gadt
| Failed : forall {aft bef : Type},
  (Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty aft ->
    Tezos_raw_protocol_alpha.Script_typed_ir.descr bef aft) * (aft) ->
  judgement_gadt

where "'judgement" := (fun (bef : Type) => judgement_gadt).

Definition judgement := 'judgement.

Inductive unparsing_mode : Type :=
| Optimized : unparsing_mode
| Readable : unparsing_mode.

Definition type_logger :=
  Z ->
    list
      (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
        Tezos_raw_protocol_alpha.Alpha_context.Script.annot) ->
      list
        (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
          Tezos_raw_protocol_alpha.Alpha_context.Script.annot) -> unit.

Parameter empty_set : forall {a : Type},
Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a ->
  Tezos_raw_protocol_alpha.Script_typed_ir.set a.

Parameter set_fold : forall {acc elt : Type},
(elt -> acc -> acc) ->
  Tezos_raw_protocol_alpha.Script_typed_ir.set elt -> acc -> acc.

Parameter set_update : forall {a : Type},
a ->
  bool ->
    Tezos_raw_protocol_alpha.Script_typed_ir.set a ->
      Tezos_raw_protocol_alpha.Script_typed_ir.set a.

Parameter set_mem : forall {elt : Type},
elt -> Tezos_raw_protocol_alpha.Script_typed_ir.set elt -> bool.

Parameter set_size : forall {elt : Type},
Tezos_raw_protocol_alpha.Script_typed_ir.set elt ->
  Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
    Tezos_raw_protocol_alpha.Alpha_context.Script_int.n.

Parameter empty_map : forall {a b : Type},
Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a ->
  Tezos_raw_protocol_alpha.Script_typed_ir.map a b.

Parameter map_fold : forall {acc key value : Type},
(key -> value -> acc -> acc) ->
  Tezos_raw_protocol_alpha.Script_typed_ir.map key value -> acc -> acc.

Parameter map_update : forall {a b : Type},
a ->
  option b ->
    Tezos_raw_protocol_alpha.Script_typed_ir.map a b ->
      Tezos_raw_protocol_alpha.Script_typed_ir.map a b.

Parameter map_mem : forall {key value : Type},
key -> Tezos_raw_protocol_alpha.Script_typed_ir.map key value -> bool.

Parameter map_get : forall {key value : Type},
key -> Tezos_raw_protocol_alpha.Script_typed_ir.map key value -> option value.

Parameter map_key_ty : forall {a b : Type},
Tezos_raw_protocol_alpha.Script_typed_ir.map a b ->
  Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a.

Parameter map_size : forall {a b : Type},
Tezos_raw_protocol_alpha.Script_typed_ir.map a b ->
  Tezos_raw_protocol_alpha.Alpha_context.Script_int.num
    Tezos_raw_protocol_alpha.Alpha_context.Script_int.n.

Parameter empty_big_map : forall {a b : Type},
Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty b ->
    Tezos_raw_protocol_alpha.Script_typed_ir.big_map a b.

Parameter big_map_mem : forall {key value : Type},
Tezos_raw_protocol_alpha.Alpha_context.context ->
  key ->
    Tezos_raw_protocol_alpha.Script_typed_ir.big_map key value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (bool * Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter big_map_get : forall {key value : Type},
Tezos_raw_protocol_alpha.Alpha_context.context ->
  key ->
    Tezos_raw_protocol_alpha.Script_typed_ir.big_map key value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value * Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter big_map_update : forall {key value : Type},
key ->
  option value ->
    Tezos_raw_protocol_alpha.Script_typed_ir.big_map key value ->
      Tezos_raw_protocol_alpha.Script_typed_ir.big_map key value.

Parameter ty_eq : forall {ta tb : Type},
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty ta ->
    Tezos_raw_protocol_alpha.Script_typed_ir.ty tb ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (eq (Tezos_raw_protocol_alpha.Script_typed_ir.ty ta)
          (Tezos_raw_protocol_alpha.Script_typed_ir.ty tb) *
          Tezos_raw_protocol_alpha.Alpha_context.context).

Parameter compare_comparable : forall {a : Type},
Tezos_raw_protocol_alpha.Script_typed_ir.comparable_ty a -> a -> a -> Z.

Parameter parse_data : forall {a : Type},
option type_logger ->
  Tezos_raw_protocol_alpha.Alpha_context.context ->
    bool ->
      Tezos_raw_protocol_alpha.Script_typed_ir.ty a ->
        Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (a * Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter unparse_data : forall {a : Type},
Tezos_raw_protocol_alpha.Alpha_context.context ->
  unparsing_mode ->
    Tezos_raw_protocol_alpha.Script_typed_ir.ty a ->
      a ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (Tezos_raw_protocol_alpha.Alpha_context.Script.node *
              Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter parse_instr : forall {bef : Type},
option type_logger ->
  tc_context ->
    Tezos_raw_protocol_alpha.Alpha_context.context ->
      bool ->
        Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
          Tezos_raw_protocol_alpha.Script_typed_ir.stack_ty bef ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                (judgement bef * Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter parse_ty :
Tezos_raw_protocol_alpha.Alpha_context.context ->
  bool ->
    bool ->
      bool ->
        bool ->
          Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
            Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (ex_ty * Tezos_raw_protocol_alpha.Alpha_context.context).

Parameter parse_packable_ty :
Tezos_raw_protocol_alpha.Alpha_context.context ->
  bool ->
    Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (ex_ty * Tezos_raw_protocol_alpha.Alpha_context.context).

Parameter unparse_ty : forall {a : Type},
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty a ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Alpha_context.Script.node *
          Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter parse_toplevel :
bool ->
  Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Alpha_context.Script.node *
        Tezos_raw_protocol_alpha.Alpha_context.Script.node *
        Tezos_raw_protocol_alpha.Alpha_context.Script.node * option string).

Parameter add_field_annot : forall {variant : Type},
option variant ->
  option variant ->
    Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
      Tezos_raw_protocol_alpha.Alpha_context.Script.node.

Parameter typecheck_code :
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Script_tc_errors.type_map *
          Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter typecheck_data :
option type_logger ->
  Tezos_raw_protocol_alpha.Alpha_context.context ->
    Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      Tezos_raw_protocol_alpha.Alpha_context.Script.expr ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Alpha_context.context).

Parameter parse_script :
option type_logger ->
  Tezos_raw_protocol_alpha.Alpha_context.context ->
    bool ->
      Tezos_raw_protocol_alpha.Alpha_context.Script.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (ex_script * Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter unparse_script : forall {a b : Type},
Tezos_raw_protocol_alpha.Alpha_context.context ->
  unparsing_mode ->
    Tezos_raw_protocol_alpha.Script_typed_ir.script a b ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Alpha_context.Script.t *
            Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter parse_contract : forall {a : Type},
bool ->
  Tezos_raw_protocol_alpha.Alpha_context.context ->
    Tezos_raw_protocol_alpha.Alpha_context.Script.location ->
      Tezos_raw_protocol_alpha.Script_typed_ir.ty a ->
        Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
          string ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                (Tezos_raw_protocol_alpha.Alpha_context.context *
                  Tezos_raw_protocol_alpha.Script_typed_ir.typed_contract a)).

Parameter parse_contract_for_script : forall {a : Type},
bool ->
  Tezos_raw_protocol_alpha.Alpha_context.context ->
    Tezos_raw_protocol_alpha.Alpha_context.Script.location ->
      Tezos_raw_protocol_alpha.Script_typed_ir.ty a ->
        Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
          string ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                (Tezos_raw_protocol_alpha.Alpha_context.context *
                  option
                    (Tezos_raw_protocol_alpha.Script_typed_ir.typed_contract a))).

Parameter find_entrypoint : forall {t : Type},
Tezos_raw_protocol_alpha.Script_typed_ir.ty t ->
  option string ->
    string ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        ((Tezos_raw_protocol_alpha.Alpha_context.Script.node ->
          Tezos_raw_protocol_alpha.Alpha_context.Script.node) * ex_ty).

unhandled_module

Parameter list_entrypoints : forall {t : Type},
Tezos_raw_protocol_alpha.Script_typed_ir.ty t ->
  Tezos_raw_protocol_alpha.Alpha_context.context ->
    option string ->
      Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (list (list Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) *
          Entrypoints_map.(Tezos_protocol_environment_alpha__Environment.MAP.S.t)
            (list Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim *
              Tezos_raw_protocol_alpha.Alpha_context.Script.node)).

Parameter pack_data : forall {a : Type},
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty a ->
    a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_protocol_environment_alpha__Environment.MBytes.t *
            Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter hash_data : forall {a : Type},
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty a ->
    a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Script_expr_hash.t *
            Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter big_map_ids : Type.

Parameter no_big_map_id : big_map_ids.

Parameter collect_big_maps : forall {a : Type},
Tezos_raw_protocol_alpha.Alpha_context.context ->
  Tezos_raw_protocol_alpha.Script_typed_ir.ty a ->
    a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (big_map_ids * Tezos_raw_protocol_alpha.Alpha_context.context)).

Parameter list_of_big_map_ids :
big_map_ids -> list Tezos_protocol_environment_alpha__Environment.Z.t.

Parameter extract_big_map_diff : forall {a : Type},
Tezos_raw_protocol_alpha.Alpha_context.context ->
  unparsing_mode ->
    bool ->
      big_map_ids ->
        big_map_ids ->
          Tezos_raw_protocol_alpha.Script_typed_ir.ty a ->
            a ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                  (a *
                    option
                      Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff
                    * Tezos_raw_protocol_alpha.Alpha_context.context)).
script_repr.ml 7 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type location = Micheline.canonical_location

let location_encoding = Micheline.canonical_location_encoding

type annot = Micheline.annot

type expr = Michelson_v1_primitives.prim Micheline.canonical

type lazy_expr = expr Data_encoding.lazy_t

type node = (location, Michelson_v1_primitives.prim) Micheline.node

let expr_encoding =
  Micheline.canonical_encoding_v1
    ~variant:"michelson_v1"
    Michelson_v1_primitives.prim_encoding

type error += Lazy_script_decode (* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"invalid_binary_format"
    ~title:"Invalid binary format"
    ~description:
      "Could not deserialize some piece of data from its binary representation"
    Data_encoding.empty
    (function Lazy_script_decode -> Some () | _ -> None)
    (fun () -> Lazy_script_decode)

let lazy_expr_encoding = Data_encoding.lazy_encoding expr_encoding

let lazy_expr expr = Data_encoding.make_lazy expr_encoding expr

type t = {code : lazy_expr; storage : lazy_expr}

let encoding =
  let open Data_encoding in
  def "scripted.contracts"
  @@ conv
       (fun {code; storage} -> (code, storage))
       (fun (code, storage) -> {code; storage})
       (obj2 (req "code" lazy_expr_encoding) (req "storage" lazy_expr_encoding))

let int_node_size_of_numbits n = (1, 1 + ((n + 63) / 64))

let int_node_size n = int_node_size_of_numbits (Z.numbits n)

let string_node_size_of_length s = (1, 1 + ((s + 7) / 8))

let string_node_size s = string_node_size_of_length (String.length s)

let bytes_node_size_of_length s =
  (* approx cost of indirection to the C heap *)
  (2, 1 + ((s + 7) / 8) + 12)

let bytes_node_size s = bytes_node_size_of_length (MBytes.length s)

let prim_node_size_nonrec_of_lengths n_args annots =
  let annots_length =
    List.fold_left (fun acc s -> acc + String.length s) 0 annots
  in
  if Compare.Int.(annots_length = 0) then (1 + n_args, 2 + (2 * n_args))
  else (2 + n_args, 4 + (2 * n_args) + ((annots_length + 7) / 8))

let prim_node_size_nonrec args annots =
  let n_args = List.length args in
  prim_node_size_nonrec_of_lengths n_args annots

let seq_node_size_nonrec_of_length n_args = (1 + n_args, 2 + (2 * n_args))

let seq_node_size_nonrec args =
  let n_args = List.length args in
  seq_node_size_nonrec_of_length n_args

let rec node_size node =
  let open Micheline in
  match node with
  | Int (_, n) ->
      int_node_size n
  | String (_, s) ->
      string_node_size s
  | Bytes (_, s) ->
      bytes_node_size s
  | Prim (_, _, args, annot) ->
      List.fold_left
        (fun (blocks, words) node ->
          let (nblocks, nwords) = node_size node in
          (blocks + nblocks, words + nwords))
        (prim_node_size_nonrec args annot)
        args
  | Seq (_, args) ->
      List.fold_left
        (fun (blocks, words) node ->
          let (nblocks, nwords) = node_size node in
          (blocks + nblocks, words + nwords))
        (seq_node_size_nonrec args)
        args

let expr_size expr = node_size (Micheline.root expr)

let traversal_cost node =
  let (blocks, _words) = node_size node in
  Gas_limit_repr.step_cost blocks

let cost_of_size (blocks, words) =
  let open Gas_limit_repr in
  (Compare.Int.max 0 (blocks - 1) *@ alloc_cost 0)
  +@ alloc_cost words +@ step_cost blocks

let node_cost node = cost_of_size (node_size node)

let int_node_cost n = cost_of_size (int_node_size n)

let int_node_cost_of_numbits n = cost_of_size (int_node_size_of_numbits n)

let string_node_cost s = cost_of_size (string_node_size s)

let string_node_cost_of_length s = cost_of_size (string_node_size_of_length s)

let bytes_node_cost s = cost_of_size (bytes_node_size s)

let bytes_node_cost_of_length s = cost_of_size (bytes_node_size_of_length s)

let prim_node_cost_nonrec args annot =
  cost_of_size (prim_node_size_nonrec args annot)

let prim_node_cost_nonrec_of_length n_args annot =
  cost_of_size (prim_node_size_nonrec_of_lengths n_args annot)

let seq_node_cost_nonrec args = cost_of_size (seq_node_size_nonrec args)

let seq_node_cost_nonrec_of_length n_args =
  cost_of_size (seq_node_size_nonrec_of_length n_args)

let deserialized_cost expr = cost_of_size (expr_size expr)

let serialized_cost bytes =
  let open Gas_limit_repr in
  alloc_mbytes_cost (MBytes.length bytes)

let force_decode lexpr =
  let account_deserialization_cost =
    Data_encoding.apply_lazy
      ~fun_value:(fun _ -> false)
      ~fun_bytes:(fun _ -> true)
      ~fun_combine:(fun _ _ -> false)
      lexpr
  in
  match Data_encoding.force_decode lexpr with
  | Some v ->
      if account_deserialization_cost then ok (v, deserialized_cost v)
      else ok (v, Gas_limit_repr.free)
  | None ->
      error Lazy_script_decode

let force_bytes expr =
  let open Gas_limit_repr in
  let account_serialization_cost =
    Data_encoding.apply_lazy
      ~fun_value:(fun v -> Some v)
      ~fun_bytes:(fun _ -> None)
      ~fun_combine:(fun _ _ -> None)
      expr
  in
  match Data_encoding.force_bytes expr with
  | bytes -> (
    match account_serialization_cost with
    | Some v ->
        ok (bytes, traversal_cost (Micheline.root v) +@ serialized_cost bytes)
    | None ->
        ok (bytes, Gas_limit_repr.free) )
  | exception _ ->
      error Lazy_script_decode

let minimal_deserialize_cost lexpr =
  Data_encoding.apply_lazy
    ~fun_value:(fun _ -> Gas_limit_repr.free)
    ~fun_bytes:(fun b -> serialized_cost b)
    ~fun_combine:(fun c_free _ -> c_free)
    lexpr

let unit =
  Micheline.strip_locations (Prim (0, Michelson_v1_primitives.D_Unit, [], []))

let unit_parameter = lazy_expr unit

let is_unit_parameter =
  let unit_bytes = Data_encoding.force_bytes unit_parameter in
  Data_encoding.apply_lazy
    ~fun_value:(fun v ->
      match Micheline.root v with
      | Prim (_, Michelson_v1_primitives.D_Unit, [], []) ->
          true
      | _ ->
          false)
    ~fun_bytes:(fun b -> MBytes.( = ) b unit_bytes)
    ~fun_combine:(fun res _ -> res)

let rec strip_annotations node =
  let open Micheline in
  match node with
  | (Int (_, _) | String (_, _) | Bytes (_, _)) as leaf ->
      leaf
  | Prim (loc, name, args, _) ->
      Prim (loc, name, List.map strip_annotations args, [])
  | Seq (loc, args) ->
      Seq (loc, List.map strip_annotations args)
script_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition location :=
  Tezos_protocol_environment_alpha__Environment.Micheline.canonical_location.

Definition location_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    Tezos_protocol_environment_alpha__Environment.Micheline.canonical_location :=
  Micheline.canonical_location_encoding.

Definition annot :=
  Tezos_protocol_environment_alpha__Environment.Micheline.annot.

Definition expr :=
  Tezos_protocol_environment_alpha__Environment.Micheline.canonical
    Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim.

Definition lazy_expr :=
  Tezos_protocol_environment_alpha__Environment.Data_encoding.lazy_t expr.

Definition node :=
  Tezos_protocol_environment_alpha__Environment.Micheline.node location
    Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim.

Definition expr_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (Tezos_protocol_environment_alpha__Environment.Micheline.canonical
      Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) :=
  Micheline.canonical_encoding_v1 "michelson_v1" % string
    Michelson_v1_primitives.prim_encoding.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "invalid_binary_format" % string "Invalid binary format" % string
    "Could not deserialize some piece of data from its binary representation" %
      string None Data_encoding.empty
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Lazy_script_decode
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Lazy_script_decode).

Definition lazy_expr_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (Tezos_protocol_environment_alpha__Environment.Data_encoding.lazy_t
      (Tezos_protocol_environment_alpha__Environment.Micheline.canonical
        Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim)) :=
  Data_encoding.lazy_encoding expr_encoding.

Definition lazy_expr
  (expr :
    Tezos_protocol_environment_alpha__Environment.Micheline.canonical
      Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim)
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.lazy_t
    (Tezos_protocol_environment_alpha__Environment.Micheline.canonical
      Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) :=
  Data_encoding.make_lazy expr_encoding expr.

Record t := {
  code : lazy_expr;
  storage : lazy_expr }.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t :=
  op_atat
    (let arg := def "scripted.contracts" % string in
    fun eta => arg None None eta)
    (conv
      (fun function_parameter =>
        let '{| code := code; storage := storage |} := function_parameter in
        (code, storage))
      (fun function_parameter =>
        let '(code, storage) := function_parameter in
        {| code := code; storage := storage |}) None
      (obj2 (req None None "code" % string lazy_expr_encoding)
        (req None None "storage" % string lazy_expr_encoding))).

Definition int_node_size_of_numbits (n : Z) : Z * Z :=
  (1, (op_plus 1 (op_div (op_plus n 63) 64))).

Definition int_node_size (n : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Z * Z := int_node_size_of_numbits (Z.numbits n).

Definition string_node_size_of_length (s : Z) : Z * Z :=
  (1, (op_plus 1 (op_div (op_plus s 7) 8))).

Definition string_node_size (s : string) : Z * Z :=
  string_node_size_of_length (String.length s).

Definition bytes_node_size_of_length (s : Z) : Z * Z :=
  (2, (op_plus (op_plus 1 (op_div (op_plus s 7) 8)) 12)).

Definition bytes_node_size
  (s : Tezos_protocol_environment_alpha__Environment.MBytes.t) : Z * Z :=
  bytes_node_size_of_length (MBytes.length s).

Definition prim_node_size_nonrec_of_lengths (n_args : Z) (annots : list string)
  : Z * Z :=
  let annots_length :=
    List.fold_left (fun acc => fun s => op_plus acc (String.length s)) 0 annots
    in
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
      annots_length 0 then
    ((op_plus 1 n_args), (op_plus 2 (op_star 2 n_args)))
  else
    ((op_plus 2 n_args),
      (op_plus (op_plus 4 (op_star 2 n_args))
        (op_div (op_plus annots_length 7) 8))).

Definition prim_node_size_nonrec {A : Type}
  (args : list A) (annots : list string) : Z * Z :=
  let n_args := List.length args in
  prim_node_size_nonrec_of_lengths n_args annots.

Definition seq_node_size_nonrec_of_length (n_args : Z) : Z * Z :=
  ((op_plus 1 n_args), (op_plus 2 (op_star 2 n_args))).

Definition seq_node_size_nonrec {A : Type} (args : list A) : Z * Z :=
  let n_args := List.length args in
  seq_node_size_nonrec_of_length n_args.

Fixpoint node_size {A B : Type}
  (node : Tezos_protocol_environment_alpha__Environment.Micheline.node A B)
  : Z * Z :=
  match node with
  | Tezos_protocol_environment_alpha__Environment.Micheline.Int _ n =>
    int_node_size n
  | Tezos_protocol_environment_alpha__Environment.Micheline.String _ s =>
    string_node_size s
  | Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ s =>
    bytes_node_size s
  | Tezos_protocol_environment_alpha__Environment.Micheline.Prim _ _ args annot
    =>
    List.fold_left
      (fun function_parameter =>
        let '(blocks, words) := function_parameter in
        fun node =>
          let '(nblocks, nwords) := node_size node in
          ((op_plus blocks nblocks), (op_plus words nwords)))
      (prim_node_size_nonrec args annot) args
  | Tezos_protocol_environment_alpha__Environment.Micheline.Seq _ args =>
    List.fold_left
      (fun function_parameter =>
        let '(blocks, words) := function_parameter in
        fun node =>
          let '(nblocks, nwords) := node_size node in
          ((op_plus blocks nblocks), (op_plus words nwords)))
      (seq_node_size_nonrec args) args
  end.

Definition expr_size {A : Type}
  (expr : Tezos_protocol_environment_alpha__Environment.Micheline.canonical A)
  : Z * Z := node_size (Micheline.root expr).

Definition traversal_cost {A B : Type}
  (node : Tezos_protocol_environment_alpha__Environment.Micheline.node A B)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  let '(blocks, _words) := node_size node in
  Gas_limit_repr.step_cost blocks.

Definition cost_of_size (function_parameter : Z * Z)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  let '(blocks, words) := function_parameter in
  op_plusat
    (op_plusat
      (op_starat
        (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.max)
          0 (op_minus blocks 1)) (alloc_cost 0)) (alloc_cost words))
    (step_cost blocks).

Definition node_cost {A B : Type}
  (node : Tezos_protocol_environment_alpha__Environment.Micheline.node A B)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (node_size node).

Definition int_node_cost (n : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (int_node_size n).

Definition int_node_cost_of_numbits (n : Z)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (int_node_size_of_numbits n).

Definition string_node_cost (s : string)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (string_node_size s).

Definition string_node_cost_of_length (s : Z)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (string_node_size_of_length s).

Definition bytes_node_cost
  (s : Tezos_protocol_environment_alpha__Environment.MBytes.t)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (bytes_node_size s).

Definition bytes_node_cost_of_length (s : Z)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (bytes_node_size_of_length s).

Definition prim_node_cost_nonrec {A : Type}
  (args : list A) (annot : list string)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (prim_node_size_nonrec args annot).

Definition prim_node_cost_nonrec_of_length (n_args : Z) (annot : list string)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (prim_node_size_nonrec_of_lengths n_args annot).

Definition seq_node_cost_nonrec {A : Type} (args : list A)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (seq_node_size_nonrec args).

Definition seq_node_cost_nonrec_of_length (n_args : Z)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (seq_node_size_nonrec_of_length n_args).

Definition deserialized_cost {A : Type}
  (expr : Tezos_protocol_environment_alpha__Environment.Micheline.canonical A)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  cost_of_size (expr_size expr).

Definition serialized_cost
  (bytes : Tezos_protocol_environment_alpha__Environment.MBytes.t)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  alloc_mbytes_cost (MBytes.length string).

Definition force_decode {A : Type}
  (lexpr :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.lazy_t
      (Tezos_protocol_environment_alpha__Environment.Micheline.canonical A))
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_protocol_environment_alpha__Environment.Micheline.canonical A *
      Tezos_raw_protocol_alpha.Gas_limit_repr.cost) :=
  let account_deserialization_cost :=
    Data_encoding.apply_lazy
      (fun function_parameter =>
        let '_ := function_parameter in
        false)
      (fun function_parameter =>
        let '_ := function_parameter in
        true)
      (fun function_parameter =>
        let '_ := function_parameter in
        fun function_parameter =>
          let '_ := function_parameter in
          false) lexpr in
  match Data_encoding.force_decode lexpr with
  | Some v =>
    if account_deserialization_cost then
      ok (v, (deserialized_cost v))
    else
      ok (v, Gas_limit_repr.free)
  | None =>
    error
      Tezos_protocol_environment_alpha__Environment.Error_monad.Lazy_script_decode
  end.

Definition force_bytes {A : Type}
  (expr :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.lazy_t
      (Tezos_protocol_environment_alpha__Environment.Micheline.canonical A))
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_protocol_environment_alpha__Environment.MBytes.t *
      Tezos_raw_protocol_alpha.Gas_limit_repr.cost) :=
  let account_serialization_cost :=
    Data_encoding.apply_lazy (fun v => Some v)
      (fun function_parameter =>
        let '_ := function_parameter in
        None)
      (fun function_parameter =>
        let '_ := function_parameter in
        fun function_parameter =>
          let '_ := function_parameter in
          None) expr in
  let 'bytes := Data_encoding.force_bytes expr in
  match account_serialization_cost with
  | Some v =>
    ok
      (string,
        (op_plusat (traversal_cost (Micheline.root v)) (serialized_cost string)))
  | None => ok (string, Gas_limit_repr.free)
  end.

Definition minimal_deserialize_cost {A : Type}
  (lexpr : Tezos_protocol_environment_alpha__Environment.Data_encoding.lazy_t A)
  : Tezos_raw_protocol_alpha.Gas_limit_repr.cost :=
  Data_encoding.apply_lazy
    (fun function_parameter =>
      let '_ := function_parameter in
      Gas_limit_repr.free) (fun b => serialized_cost b)
    (fun c_free =>
      fun function_parameter =>
        let '_ := function_parameter in
        c_free) lexpr.

Definition unit
  : Tezos_protocol_environment_alpha__Environment.Micheline.canonical
    Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim :=
  Micheline.strip_locations
    (Tezos_protocol_environment_alpha__Environment.Micheline.Prim 0
      Tezos_raw_protocol_alpha.Michelson_v1_primitives.D_Unit [] []).

Definition unit_parameter
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.lazy_t
    (Tezos_protocol_environment_alpha__Environment.Micheline.canonical
      Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) := lazy_expr unit.

Definition is_unit_parameter
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.lazy_t
    (Tezos_protocol_environment_alpha__Environment.Micheline.canonical
      Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim) -> bool :=
  let unit_bytes := Data_encoding.force_bytes unit_parameter in
  Data_encoding.apply_lazy
    (fun v =>
      match Micheline.root v with
      |
        Tezos_protocol_environment_alpha__Environment.Micheline.Prim _
          Tezos_raw_protocol_alpha.Michelson_v1_primitives.D_Unit [] [] => true
      | _ => false
      end) (fun b => MBytes.op_eq b unit_bytes)
    (fun res =>
      fun function_parameter =>
        let '_ := function_parameter in
        res).

Fixpoint strip_annotations {A B : Type}
  (node : Tezos_protocol_environment_alpha__Environment.Micheline.node A B)
  : Tezos_protocol_environment_alpha__Environment.Micheline.node A B :=
  match node with
  |
    (Tezos_protocol_environment_alpha__Environment.Micheline.Int _ _ |
      Tezos_protocol_environment_alpha__Environment.Micheline.String _ _ |
      Tezos_protocol_environment_alpha__Environment.Micheline.Bytes _ _) as leaf
    => leaf
  | Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc name args _
    =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Prim loc name
      (List.map strip_annotations args) []
  | Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc args =>
    Tezos_protocol_environment_alpha__Environment.Micheline.Seq loc
      (List.map strip_annotations args)
  end.
script_repr.mli 2 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type location = Micheline.canonical_location

type annot = Micheline.annot

type expr = Michelson_v1_primitives.prim Micheline.canonical

type error += Lazy_script_decode (* `Permanent *)

type lazy_expr = expr Data_encoding.lazy_t

type node = (location, Michelson_v1_primitives.prim) Micheline.node

val location_encoding : location Data_encoding.t

val expr_encoding : expr Data_encoding.t

val lazy_expr_encoding : lazy_expr Data_encoding.t

val lazy_expr : expr -> lazy_expr

type t = {code : lazy_expr; storage : lazy_expr}

val encoding : t Data_encoding.encoding

val deserialized_cost : expr -> Gas_limit_repr.cost

val serialized_cost : MBytes.t -> Gas_limit_repr.cost

val traversal_cost : node -> Gas_limit_repr.cost

val node_cost : node -> Gas_limit_repr.cost

val int_node_cost : Z.t -> Gas_limit_repr.cost

val int_node_cost_of_numbits : int -> Gas_limit_repr.cost

val string_node_cost : string -> Gas_limit_repr.cost

val string_node_cost_of_length : int -> Gas_limit_repr.cost

val bytes_node_cost : MBytes.t -> Gas_limit_repr.cost

val bytes_node_cost_of_length : int -> Gas_limit_repr.cost

val prim_node_cost_nonrec : expr list -> annot -> Gas_limit_repr.cost

val prim_node_cost_nonrec_of_length : int -> annot -> Gas_limit_repr.cost

val seq_node_cost_nonrec : expr list -> Gas_limit_repr.cost

val seq_node_cost_nonrec_of_length : int -> Gas_limit_repr.cost

val force_decode : lazy_expr -> (expr * Gas_limit_repr.cost) tzresult

val force_bytes : lazy_expr -> (MBytes.t * Gas_limit_repr.cost) tzresult

val minimal_deserialize_cost : lazy_expr -> Gas_limit_repr.cost

val unit_parameter : lazy_expr

val is_unit_parameter : lazy_expr -> bool

val strip_annotations : node -> node
script_repr_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition location :=
  Tezos_protocol_environment_alpha__Environment.Micheline.canonical_location.

Definition annot :=
  Tezos_protocol_environment_alpha__Environment.Micheline.annot.

Definition expr :=
  Tezos_protocol_environment_alpha__Environment.Micheline.canonical
    Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim.

extensible_type

Definition lazy_expr :=
  Tezos_protocol_environment_alpha__Environment.Data_encoding.lazy_t expr.

Definition node :=
  Tezos_protocol_environment_alpha__Environment.Micheline.node location
    Tezos_raw_protocol_alpha.Michelson_v1_primitives.prim.

Parameter location_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t location.

Parameter expr_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t expr.

Parameter lazy_expr_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t lazy_expr.

Parameter lazy_expr : expr -> lazy_expr.

Record t := {
  code : lazy_expr;
  storage : lazy_expr }.

Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding t.

Parameter deserialized_cost :
expr -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter serialized_cost :
Tezos_protocol_environment_alpha__Environment.MBytes.t ->
  Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter traversal_cost : node -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter node_cost : node -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter int_node_cost :
Tezos_protocol_environment_alpha__Environment.Z.t ->
  Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter int_node_cost_of_numbits :
Z -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter string_node_cost :
string -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter string_node_cost_of_length :
Z -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter bytes_node_cost :
Tezos_protocol_environment_alpha__Environment.MBytes.t ->
  Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter bytes_node_cost_of_length :
Z -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter prim_node_cost_nonrec :
list expr -> annot -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter prim_node_cost_nonrec_of_length :
Z -> annot -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter seq_node_cost_nonrec :
list expr -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter seq_node_cost_nonrec_of_length :
Z -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter force_decode :
lazy_expr ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (expr * Tezos_raw_protocol_alpha.Gas_limit_repr.cost).

Parameter force_bytes :
lazy_expr ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    (Tezos_protocol_environment_alpha__Environment.MBytes.t *
      Tezos_raw_protocol_alpha.Gas_limit_repr.cost).

Parameter minimal_deserialize_cost :
lazy_expr -> Tezos_raw_protocol_alpha.Gas_limit_repr.cost.

Parameter unit_parameter : lazy_expr.

Parameter is_unit_parameter : lazy_expr -> bool.

Parameter strip_annotations : node -> node.
script_tc_errors.ml 47 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Script

(* ---- Error definitions ---------------------------------------------------*)

(* Auxiliary types for error documentation *)
type namespace =
  | Type_namespace
  | Constant_namespace
  | Instr_namespace
  | Keyword_namespace

type kind = Int_kind | String_kind | Bytes_kind | Prim_kind | Seq_kind

type unparsed_stack_ty = (Script.expr * Script.annot) list

type type_map = (int * (unparsed_stack_ty * unparsed_stack_ty)) list

(* Structure errors *)
type error += Invalid_arity of Script.location * prim * int * int

type error +=
  | Invalid_namespace of Script.location * prim * namespace * namespace

type error += Invalid_primitive of Script.location * prim list * prim

type error += Invalid_kind of Script.location * kind list * kind

type error += Missing_field of prim

type error += Duplicate_field of Script.location * prim

type error += Unexpected_big_map of Script.location

type error += Unexpected_operation of Script.location

type error += Unexpected_contract of Script.location

type error += No_such_entrypoint of string

type error += Duplicate_entrypoint of string

type error += Unreachable_entrypoint of prim list

type error += Entrypoint_name_too_long of string

(* Instruction typing errors *)
type error += Fail_not_in_tail_position of Script.location

type error +=
  | Undefined_binop :
      Script.location * prim * Script.expr * Script.expr
      -> error

type error += Undefined_unop : Script.location * prim * Script.expr -> error

type error +=
  | Bad_return : Script.location * unparsed_stack_ty * Script.expr -> error

type error +=
  | Bad_stack : Script.location * prim * int * unparsed_stack_ty -> error

type error +=
  | Unmatched_branches :
      Script.location * unparsed_stack_ty * unparsed_stack_ty
      -> error

type error += Self_in_lambda of Script.location

type error += Bad_stack_length

type error += Bad_stack_item of int

type error += Inconsistent_annotations of string * string

type error +=
  | Inconsistent_type_annotations :
      Script.location * Script.expr * Script.expr
      -> error

type error += Inconsistent_field_annotations of string * string

type error += Unexpected_annotation of Script.location

type error += Ungrouped_annotations of Script.location

type error += Invalid_map_body : Script.location * unparsed_stack_ty -> error

type error += Invalid_map_block_fail of Script.location

type error +=
  | Invalid_iter_body :
      Script.location * unparsed_stack_ty * unparsed_stack_ty
      -> error

type error += Type_too_large : Script.location * int * int -> error

(* Value typing errors *)
type error +=
  | Invalid_constant : Script.location * Script.expr * Script.expr -> error

type error +=
  | Invalid_syntactic_constant :
      Script.location * Script.expr * string
      -> error

type error += Invalid_contract of Script.location * Contract.t

type error += Invalid_big_map of Script.location * Big_map.id

type error +=
  | Comparable_type_expected : Script.location * Script.expr -> error

type error += Inconsistent_types : Script.expr * Script.expr -> error

type error += Unordered_map_keys of Script.location * Script.expr

type error += Unordered_set_values of Script.location * Script.expr

type error += Duplicate_map_keys of Script.location * Script.expr

type error += Duplicate_set_values of Script.location * Script.expr

(* Toplevel errors *)
type error +=
  | Ill_typed_data : string option * Script.expr * Script.expr -> error

type error +=
  | Ill_formed_type of string option * Script.expr * Script.location

type error += Ill_typed_contract : Script.expr * type_map -> error

(* Gas related errors *)
type error += Cannot_serialize_error

(* Deprecation errors *)
type error += Deprecated_instruction of prim
script_tc_errors_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Import Script.

Inductive namespace : Type :=
| Type_namespace : namespace
| Constant_namespace : namespace
| Instr_namespace : namespace
| Keyword_namespace : namespace.

Inductive kind : Type :=
| Int_kind : kind
| String_kind : kind
| Bytes_kind : kind
| Prim_kind : kind
| Seq_kind : kind.

Definition unparsed_stack_ty :=
  list
    (Tezos_raw_protocol_alpha.Alpha_context.Script.expr *
      Tezos_raw_protocol_alpha.Alpha_context.Script.annot).

Definition type_map := list (Z * (unparsed_stack_ty * unparsed_stack_ty)).

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension
script_tc_errors_registration.ml 93 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Script
open Script_tc_errors

(* Helpers for encoding *)
let type_map_enc =
  let open Data_encoding in
  let stack_enc = list (tup2 Script.expr_encoding (list string)) in
  list
    (conv
       (fun (loc, (bef, aft)) -> (loc, bef, aft))
       (fun (loc, bef, aft) -> (loc, (bef, aft)))
       (obj3
          (req "location" Script.location_encoding)
          (req "stack_before" stack_enc)
          (req "stack_after" stack_enc)))

let stack_ty_enc =
  let open Data_encoding in
  list (obj2 (req "type" Script.expr_encoding) (dft "annots" (list string) []))

(* main registration *)
let () =
  let open Data_encoding in
  let located enc =
    merge_objs (obj1 (req "location" Script.location_encoding)) enc
  in
  let arity_enc = int8 in
  let namespace_enc =
    def
      "primitiveNamespace"
      ~title:"Primitive namespace"
      ~description:
        "One of the three possible namespaces of primitive (data constructor, \
         type name or instruction)."
    @@ string_enum
         [ ("type", Type_namespace);
           ("constant", Constant_namespace);
           ("instruction", Instr_namespace) ]
  in
  let kind_enc =
    def
      "expressionKind"
      ~title:"Expression kind"
      ~description:
        "One of the four possible kinds of expression (integer, string, \
         primitive application or sequence)."
    @@ string_enum
         [ ("integer", Int_kind);
           ("string", String_kind);
           ("bytes", Bytes_kind);
           ("primitiveApplication", Prim_kind);
           ("sequence", Seq_kind) ]
  in
  (* -- Structure errors ---------------------- *)
  (* Invalid arity *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_arity"
    ~title:"Invalid arity"
    ~description:
      "In a script or data expression, a primitive was applied to an \
       unsupported number of arguments."
    (located
       (obj3
          (req "primitive_name" Script.prim_encoding)
          (req "expected_arity" arity_enc)
          (req "wrong_arity" arity_enc)))
    (function
      | Invalid_arity (loc, name, exp, got) ->
          Some (loc, (name, exp, got))
      | _ ->
          None)
    (fun (loc, (name, exp, got)) -> Invalid_arity (loc, name, exp, got)) ;
  (* Missing field *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.missing_script_field"
    ~title:"Script is missing a field (parse error)"
    ~description:"When parsing script, a field was expected, but not provided"
    (obj1 (req "prim" prim_encoding))
    (function Missing_field prim -> Some prim | _ -> None)
    (fun prim -> Missing_field prim) ;
  (* Invalid primitive *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_primitive"
    ~title:"Invalid primitive"
    ~description:"In a script or data expression, a primitive was unknown."
    (located
       (obj2
          (dft "expected_primitive_names" (list prim_encoding) [])
          (req "wrong_primitive_name" prim_encoding)))
    (function
      | Invalid_primitive (loc, exp, got) -> Some (loc, (exp, got)) | _ -> None)
    (fun (loc, (exp, got)) -> Invalid_primitive (loc, exp, got)) ;
  (* Invalid kind *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_expression_kind"
    ~title:"Invalid expression kind"
    ~description:
      "In a script or data expression, an expression was of the wrong kind \
       (for instance a string where only a primitive applications can appear)."
    (located
       (obj2 (req "expected_kinds" (list kind_enc)) (req "wrong_kind" kind_enc)))
    (function
      | Invalid_kind (loc, exp, got) -> Some (loc, (exp, got)) | _ -> None)
    (fun (loc, (exp, got)) -> Invalid_kind (loc, exp, got)) ;
  (* Invalid namespace *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_primitive_namespace"
    ~title:"Invalid primitive namespace"
    ~description:
      "In a script or data expression, a primitive was of the wrong namespace."
    (located
       (obj3
          (req "primitive_name" prim_encoding)
          (req "expected_namespace" namespace_enc)
          (req "wrong_namespace" namespace_enc)))
    (function
      | Invalid_namespace (loc, name, exp, got) ->
          Some (loc, (name, exp, got))
      | _ ->
          None)
    (fun (loc, (name, exp, got)) -> Invalid_namespace (loc, name, exp, got)) ;
  (* Duplicate field *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.duplicate_script_field"
    ~title:"Script has a duplicated field (parse error)"
    ~description:"When parsing script, a field was found more than once"
    (obj2 (req "loc" location_encoding) (req "prim" prim_encoding))
    (function Duplicate_field (loc, prim) -> Some (loc, prim) | _ -> None)
    (fun (loc, prim) -> Duplicate_field (loc, prim)) ;
  (* Unexpected big_map *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.unexpected_bigmap"
    ~title:"Big map in unauthorized position (type error)"
    ~description:
      "When parsing script, a big_map type was found in a position where it \
       could end up stored inside a big_map, which is forbidden for now."
    (obj1 (req "loc" location_encoding))
    (function Unexpected_big_map loc -> Some loc | _ -> None)
    (fun loc -> Unexpected_big_map loc) ;
  (* Unexpected operation *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.unexpected_operation"
    ~title:"Operation in unauthorized position (type error)"
    ~description:
      "When parsing script, an operation type was found in the storage or \
       parameter field."
    (obj1 (req "loc" location_encoding))
    (function Unexpected_operation loc -> Some loc | _ -> None)
    (fun loc -> Unexpected_operation loc) ;
  (* No such entrypoint *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.no_such_entrypoint"
    ~title:"No such entrypoint (type error)"
    ~description:"An entrypoint was not found when calling a contract."
    (obj1 (req "entrypoint" string))
    (function No_such_entrypoint entrypoint -> Some entrypoint | _ -> None)
    (fun entrypoint -> No_such_entrypoint entrypoint) ;
  (* Unreachable entrypoint *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.unreachable_entrypoint"
    ~title:"Unreachable entrypoint (type error)"
    ~description:"An entrypoint in the contract is not reachable."
    (obj1 (req "path" (list prim_encoding)))
    (function Unreachable_entrypoint path -> Some path | _ -> None)
    (fun path -> Unreachable_entrypoint path) ;
  (* Duplicate entrypoint *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.duplicate_entrypoint"
    ~title:"Duplicate entrypoint (type error)"
    ~description:"Two entrypoints have the same name."
    (obj1 (req "path" string))
    (function Duplicate_entrypoint entrypoint -> Some entrypoint | _ -> None)
    (fun entrypoint -> Duplicate_entrypoint entrypoint) ;
  (* Entrypoint name too long *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.entrypoint_name_too_long"
    ~title:"Entrypoint name too long (type error)"
    ~description:
      "An entrypoint name exceeds the maximum length of 31 characters."
    (obj1 (req "name" string))
    (function
      | Entrypoint_name_too_long entrypoint -> Some entrypoint | _ -> None)
    (fun entrypoint -> Entrypoint_name_too_long entrypoint) ;
  (* Unexpected contract *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.unexpected_contract"
    ~title:"Contract in unauthorized position (type error)"
    ~description:
      "When parsing script, a contract type was found in the storage or \
       parameter field."
    (obj1 (req "loc" location_encoding))
    (function Unexpected_contract loc -> Some loc | _ -> None)
    (fun loc -> Unexpected_contract loc) ;
  (* -- Value typing errors ---------------------- *)
  (* Unordered map keys *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.unordered_map_literal"
    ~title:"Invalid map key order"
    ~description:"Map keys must be in strictly increasing order"
    (obj2
       (req "location" Script.location_encoding)
       (req "item" Script.expr_encoding))
    (function Unordered_map_keys (loc, expr) -> Some (loc, expr) | _ -> None)
    (fun (loc, expr) -> Unordered_map_keys (loc, expr)) ;
  (* Duplicate map keys *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.duplicate_map_keys"
    ~title:"Duplicate map keys"
    ~description:"Map literals cannot contain duplicated keys"
    (obj2
       (req "location" Script.location_encoding)
       (req "item" Script.expr_encoding))
    (function Duplicate_map_keys (loc, expr) -> Some (loc, expr) | _ -> None)
    (fun (loc, expr) -> Duplicate_map_keys (loc, expr)) ;
  (* Unordered set values *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.unordered_set_literal"
    ~title:"Invalid set value order"
    ~description:"Set values must be in strictly increasing order"
    (obj2
       (req "location" Script.location_encoding)
       (req "value" Script.expr_encoding))
    (function
      | Unordered_set_values (loc, expr) -> Some (loc, expr) | _ -> None)
    (fun (loc, expr) -> Unordered_set_values (loc, expr)) ;
  (* Duplicate set values *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.duplicate_set_values_in_literal"
    ~title:"Sets literals cannot contain duplicate elements"
    ~description:
      "Set literals cannot contain duplicate elements, but a duplicae was \
       found while parsing."
    (obj2
       (req "location" Script.location_encoding)
       (req "value" Script.expr_encoding))
    (function
      | Duplicate_set_values (loc, expr) -> Some (loc, expr) | _ -> None)
    (fun (loc, expr) -> Duplicate_set_values (loc, expr)) ;
  (* -- Instruction typing errors ------------- *)
  (* Fail not in tail position *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.fail_not_in_tail_position"
    ~title:"FAIL not in tail position"
    ~description:"There is non trivial garbage code after a FAIL instruction."
    (located empty)
    (function Fail_not_in_tail_position loc -> Some (loc, ()) | _ -> None)
    (fun (loc, ()) -> Fail_not_in_tail_position loc) ;
  (* Undefined binary operation *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.undefined_binop"
    ~title:"Undefined binop"
    ~description:
      "A binary operation is called on operands of types over which it is not \
       defined."
    (located
       (obj3
          (req "operator_name" prim_encoding)
          (req "wrong_left_operand_type" Script.expr_encoding)
          (req "wrong_right_operand_type" Script.expr_encoding)))
    (function
      | Undefined_binop (loc, n, tyl, tyr) ->
          Some (loc, (n, tyl, tyr))
      | _ ->
          None)
    (fun (loc, (n, tyl, tyr)) -> Undefined_binop (loc, n, tyl, tyr)) ;
  (* Undefined unary operation *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.undefined_unop"
    ~title:"Undefined unop"
    ~description:
      "A unary operation is called on an operand of type over which it is not \
       defined."
    (located
       (obj2
          (req "operator_name" prim_encoding)
          (req "wrong_operand_type" Script.expr_encoding)))
    (function Undefined_unop (loc, n, ty) -> Some (loc, (n, ty)) | _ -> None)
    (fun (loc, (n, ty)) -> Undefined_unop (loc, n, ty)) ;
  (* Bad return *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.bad_return"
    ~title:"Bad return"
    ~description:"Unexpected stack at the end of a lambda or script."
    (located
       (obj2
          (req "expected_return_type" Script.expr_encoding)
          (req "wrong_stack_type" stack_ty_enc)))
    (function Bad_return (loc, sty, ty) -> Some (loc, (ty, sty)) | _ -> None)
    (fun (loc, (ty, sty)) -> Bad_return (loc, sty, ty)) ;
  (* Bad stack *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.bad_stack"
    ~title:"Bad stack"
    ~description:"The stack has an unexpected length or contents."
    (located
       (obj3
          (req "primitive_name" prim_encoding)
          (req "relevant_stack_portion" int16)
          (req "wrong_stack_type" stack_ty_enc)))
    (function
      | Bad_stack (loc, name, s, sty) -> Some (loc, (name, s, sty)) | _ -> None)
    (fun (loc, (name, s, sty)) -> Bad_stack (loc, name, s, sty)) ;
  (* Inconsistent annotations *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.inconsistent_annotations"
    ~title:"Annotations inconsistent between branches"
    ~description:"The annotations on two types could not be merged"
    (obj2 (req "annot1" string) (req "annot2" string))
    (function
      | Inconsistent_annotations (annot1, annot2) ->
          Some (annot1, annot2)
      | _ ->
          None)
    (fun (annot1, annot2) -> Inconsistent_annotations (annot1, annot2)) ;
  (* Inconsistent field annotations *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.inconsistent_field_annotations"
    ~title:"Annotations for field accesses is inconsistent"
    ~description:
      "The specified field does not match the field annotation in the type"
    (obj2 (req "annot1" string) (req "annot2" string))
    (function
      | Inconsistent_field_annotations (annot1, annot2) ->
          Some (annot1, annot2)
      | _ ->
          None)
    (fun (annot1, annot2) -> Inconsistent_field_annotations (annot1, annot2)) ;
  (* Inconsistent type annotations *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.inconsistent_type_annotations"
    ~title:"Types contain inconsistent annotations"
    ~description:"The two types contain annotations that do not match"
    (located
       (obj2
          (req "type1" Script.expr_encoding)
          (req "type2" Script.expr_encoding)))
    (function
      | Inconsistent_type_annotations (loc, ty1, ty2) ->
          Some (loc, (ty1, ty2))
      | _ ->
          None)
    (fun (loc, (ty1, ty2)) -> Inconsistent_type_annotations (loc, ty1, ty2)) ;
  (* Unexpected annotation *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.unexpected_annotation"
    ~title:"An annotation was encountered where no annotation is expected"
    ~description:"A node in the syntax tree was impropperly annotated"
    (located empty)
    (function Unexpected_annotation loc -> Some (loc, ()) | _ -> None)
    (fun (loc, ()) -> Unexpected_annotation loc) ;
  (* Ungrouped annotations *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.ungrouped_annotations"
    ~title:"Annotations of the same kind were found spread apart"
    ~description:"Annotations of the same kind must be grouped"
    (located empty)
    (function Ungrouped_annotations loc -> Some (loc, ()) | _ -> None)
    (fun (loc, ()) -> Ungrouped_annotations loc) ;
  (* Unmatched branches *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.unmatched_branches"
    ~title:"Unmatched branches"
    ~description:
      "At the join point at the end of two code branches the stacks have \
       inconsistent lengths or contents."
    (located
       (obj2
          (req "first_stack_type" stack_ty_enc)
          (req "other_stack_type" stack_ty_enc)))
    (function
      | Unmatched_branches (loc, stya, styb) ->
          Some (loc, (stya, styb))
      | _ ->
          None)
    (fun (loc, (stya, styb)) -> Unmatched_branches (loc, stya, styb)) ;
  (* Bad stack item *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.bad_stack_item"
    ~title:"Bad stack item"
    ~description:
      "The type of a stack item is unexpected (this error is always \
       accompanied by a more precise one)."
    (obj1 (req "item_level" int16))
    (function Bad_stack_item n -> Some n | _ -> None)
    (fun n -> Bad_stack_item n) ;
  (* SELF in lambda *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.self_in_lambda"
    ~title:"SELF instruction in lambda"
    ~description:"A SELF instruction was encountered in a lambda expression."
    (located empty)
    (function Self_in_lambda loc -> Some (loc, ()) | _ -> None)
    (fun (loc, ()) -> Self_in_lambda loc) ;
  (* Bad stack length *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.inconsistent_stack_lengths"
    ~title:"Inconsistent stack lengths"
    ~description:
      "A stack was of an unexpected length (this error is always in the \
       context of a located error)."
    empty
    (function Bad_stack_length -> Some () | _ -> None)
    (fun () -> Bad_stack_length) ;
  (* -- Value typing errors ------------------- *)
  (* Invalid constant *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_constant"
    ~title:"Invalid constant"
    ~description:"A data expression was invalid for its expected type."
    (located
       (obj2
          (req "expected_type" Script.expr_encoding)
          (req "wrong_expression" Script.expr_encoding)))
    (function
      | Invalid_constant (loc, expr, ty) -> Some (loc, (ty, expr)) | _ -> None)
    (fun (loc, (ty, expr)) -> Invalid_constant (loc, expr, ty)) ;
  (* Invalid syntactic constant *)
  register_error_kind
    `Permanent
    ~id:"invalidSyntacticConstantError"
    ~title:"Invalid constant (parse error)"
    ~description:"A compile-time constant was invalid for its expected form."
    (located
       (obj2
          (req "expectedForm" Script.expr_encoding)
          (req "wrongExpression" Script.expr_encoding)))
    (function
      | Invalid_constant (loc, expr, ty) -> Some (loc, (ty, expr)) | _ -> None)
    (fun (loc, (ty, expr)) -> Invalid_constant (loc, expr, ty)) ;
  (* Invalid contract *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_contract"
    ~title:"Invalid contract"
    ~description:
      "A script or data expression references a contract that does not exist \
       or assumes a wrong type for an existing contract."
    (located (obj1 (req "contract" Contract.encoding)))
    (function Invalid_contract (loc, c) -> Some (loc, c) | _ -> None)
    (fun (loc, c) -> Invalid_contract (loc, c)) ;
  (* Invalid big_map *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_big_map"
    ~title:"Invalid big_map"
    ~description:
      "A script or data expression references a big_map that does not exist \
       or assumes a wrong type for an existing big_map."
    (located (obj1 (req "big_map" z)))
    (function Invalid_big_map (loc, c) -> Some (loc, c) | _ -> None)
    (fun (loc, c) -> Invalid_big_map (loc, c)) ;
  (* Comparable type expected *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.comparable_type_expected"
    ~title:"Comparable type expected"
    ~description:
      "A non comparable type was used in a place where only comparable types \
       are accepted."
    (located (obj1 (req "wrong_type" Script.expr_encoding)))
    (function
      | Comparable_type_expected (loc, ty) -> Some (loc, ty) | _ -> None)
    (fun (loc, ty) -> Comparable_type_expected (loc, ty)) ;
  (* Inconsistent types *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.inconsistent_types"
    ~title:"Inconsistent types"
    ~description:
      "This is the basic type clash error, that appears in several places \
       where the equality of two types have to be proven, it is always \
       accompanied with another error that provides more context."
    (obj2
       (req "first_type" Script.expr_encoding)
       (req "other_type" Script.expr_encoding))
    (function Inconsistent_types (tya, tyb) -> Some (tya, tyb) | _ -> None)
    (fun (tya, tyb) -> Inconsistent_types (tya, tyb)) ;
  (* -- Instruction typing errors ------------------- *)
  (* Invalid map body *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_map_body"
    ~title:"Invalid map body"
    ~description:"The body of a map block did not match the expected type"
    (obj2 (req "loc" Script.location_encoding) (req "body_type" stack_ty_enc))
    (function Invalid_map_body (loc, stack) -> Some (loc, stack) | _ -> None)
    (fun (loc, stack) -> Invalid_map_body (loc, stack)) ;
  (* Invalid map block FAIL *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_map_block_fail"
    ~title:"FAIL instruction occurred as body of map block"
    ~description:
      "FAIL cannot be the only instruction in the body. The propper type of \
       the return list cannot be inferred."
    (obj1 (req "loc" Script.location_encoding))
    (function Invalid_map_block_fail loc -> Some loc | _ -> None)
    (fun loc -> Invalid_map_block_fail loc) ;
  (* Invalid ITER body *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_iter_body"
    ~title:"ITER body returned wrong stack type"
    ~description:
      "The body of an ITER instruction must result in the same stack type as \
       before the ITER."
    (obj3
       (req "loc" Script.location_encoding)
       (req "bef_stack" stack_ty_enc)
       (req "aft_stack" stack_ty_enc))
    (function
      | Invalid_iter_body (loc, bef, aft) -> Some (loc, bef, aft) | _ -> None)
    (fun (loc, bef, aft) -> Invalid_iter_body (loc, bef, aft)) ;
  (* Type too large *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.type_too_large"
    ~title:"Stack item type too large"
    ~description:"An instruction generated a type larger than the limit."
    (obj3
       (req "loc" Script.location_encoding)
       (req "type_size" uint16)
       (req "maximum_type_size" uint16))
    (function
      | Type_too_large (loc, ts, maxts) -> Some (loc, ts, maxts) | _ -> None)
    (fun (loc, ts, maxts) -> Type_too_large (loc, ts, maxts)) ;
  (* -- Toplevel errors ------------------- *)
  (* Ill typed data *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.ill_typed_data"
    ~title:"Ill typed data"
    ~description:
      "The toplevel error thrown when trying to typecheck a data expression \
       against a given type (always followed by more precise errors)."
    (obj3
       (opt "identifier" string)
       (req "expected_type" Script.expr_encoding)
       (req "ill_typed_expression" Script.expr_encoding))
    (function
      | Ill_typed_data (name, expr, ty) -> Some (name, ty, expr) | _ -> None)
    (fun (name, ty, expr) -> Ill_typed_data (name, expr, ty)) ;
  (* Ill formed type *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.ill_formed_type"
    ~title:"Ill formed type"
    ~description:
      "The toplevel error thrown when trying to parse a type expression \
       (always followed by more precise errors)."
    (obj3
       (opt "identifier" string)
       (req "ill_formed_expression" Script.expr_encoding)
       (req "location" Script.location_encoding))
    (function
      | Ill_formed_type (name, expr, loc) -> Some (name, expr, loc) | _ -> None)
    (fun (name, expr, loc) -> Ill_formed_type (name, expr, loc)) ;
  (* Ill typed contract *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.ill_typed_contract"
    ~title:"Ill typed contract"
    ~description:
      "The toplevel error thrown when trying to typecheck a contract code \
       against given input, output and storage types (always followed by more \
       precise errors)."
    (obj2
       (req "ill_typed_code" Script.expr_encoding)
       (req "type_map" type_map_enc))
    (function
      | Ill_typed_contract (expr, type_map) ->
          Some (expr, type_map)
      | _ ->
          None)
    (fun (expr, type_map) -> Ill_typed_contract (expr, type_map)) ;
  (* Cannot serialize error *)
  register_error_kind
    `Temporary
    ~id:"michelson_v1.cannot_serialize_error"
    ~title:"Not enough gas to serialize error"
    ~description:"The error was too big to be serialized with the provided gas"
    Data_encoding.empty
    (function Cannot_serialize_error -> Some () | _ -> None)
    (fun () -> Cannot_serialize_error) ;
  (* Deprecated instruction *)
  register_error_kind
    `Permanent
    ~id:"michelson_v1.deprecated_instruction"
    ~title:"Script is using a deprecated instruction"
    ~description:
      "A deprecated instruction usage is disallowed in newly created contracts"
    (obj1 (req "prim" prim_encoding))
    (function Deprecated_instruction prim -> Some prim | _ -> None)
    (fun prim -> Deprecated_instruction prim)
script_tc_errors_registration_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Import Script.

Import Script_tc_errors.

Definition type_map_enc
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (list
      (Tezos_raw_protocol_alpha.Alpha_context.Script.location *
        (list (Tezos_raw_protocol_alpha.Alpha_context.Script.expr * list string)
          *
          list
            (Tezos_raw_protocol_alpha.Alpha_context.Script.expr * list string)))) :=
  let stack_enc := list None (tup2 Script.expr_encoding (list None string)) in
  list None
    (conv
      (fun function_parameter =>
        let '(loc, (bef, aft)) := function_parameter in
        (loc, bef, aft))
      (fun function_parameter =>
        let '(loc, bef, aft) := function_parameter in
        (loc, (bef, aft))) None
      (obj3 (req None None "location" % string Script.location_encoding)
        (req None None "stack_before" % string stack_enc)
        (req None None "stack_after" % string stack_enc))).

Definition stack_ty_enc
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (list (Tezos_raw_protocol_alpha.Alpha_context.Script.expr * list string)) :=
  list None
    (obj2 (req None None "type" % string Script.expr_encoding)
      (dft None None "annots" % string (list None string) [])).

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  let located {A : Type}
    (enc :
    Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding A)
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      (Tezos_raw_protocol_alpha.Alpha_context.Script.location * A) :=
    merge_objs
      (obj1 (req None None "location" % string Script.location_encoding)) enc in
  let arity_enc := int8 in
  let namespace_enc :=
    op_atat
      (def "primitiveNamespace" % string (Some "Primitive namespace" % string)
        (Some
          "One of the three possible namespaces of primitive (data constructor, type name or instruction)."
            % string))
      (string_enum
        (cons
          ("type" % string,
            Tezos_raw_protocol_alpha.Script_tc_errors.Type_namespace)
          (cons
            ("constant" % string,
              Tezos_raw_protocol_alpha.Script_tc_errors.Constant_namespace)
            (cons
              ("instruction" % string,
                Tezos_raw_protocol_alpha.Script_tc_errors.Instr_namespace) []))))
    in
  let kind_enc :=
    op_atat
      (def "expressionKind" % string (Some "Expression kind" % string)
        (Some
          "One of the four possible kinds of expression (integer, string, primitive application or sequence)."
            % string))
      (string_enum
        (cons
          ("integer" % string,
            Tezos_raw_protocol_alpha.Script_tc_errors.Int_kind)
          (cons
            ("string" % string,
              Tezos_raw_protocol_alpha.Script_tc_errors.String_kind)
            (cons
              ("bytes" % string,
                Tezos_raw_protocol_alpha.Script_tc_errors.Bytes_kind)
              (cons
                ("primitiveApplication" % string,
                  Tezos_raw_protocol_alpha.Script_tc_errors.Prim_kind)
                (cons
                  ("sequence" % string,
                    Tezos_raw_protocol_alpha.Script_tc_errors.Seq_kind) []))))))
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_arity" % string "Invalid arity" % string
      "In a script or data expression, a primitive was applied to an unsupported number of arguments."
        % string None
      (located
        (obj3 (req None None "primitive_name" % string Script.prim_encoding)
          (req None None "expected_arity" % string arity_enc)
          (req None None "wrong_arity" % string arity_enc)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
            loc name exp got => Some (loc, (name, exp, got))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (name, exp, got)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_arity
          loc name exp got) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.missing_script_field" % string
      "Script is missing a field (parse error)" % string
      "When parsing script, a field was expected, but not provided" % string
      None (obj1 (req None None "prim" % string prim_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Missing_field
            prim => Some prim
        | _ => None
        end)
      (fun prim =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Missing_field
          prim) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_primitive" % string
      "Invalid primitive" % string
      "In a script or data expression, a primitive was unknown." % string None
      (located
        (obj2
          (dft None None "expected_primitive_names" % string
            (list None prim_encoding) [])
          (req None None "wrong_primitive_name" % string prim_encoding)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_primitive
            loc exp got => Some (loc, (exp, got))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (exp, got)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_primitive
          loc exp got) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_expression_kind" % string
      "Invalid expression kind" % string
      "In a script or data expression, an expression was of the wrong kind (for instance a string where only a primitive applications can appear)."
        % string None
      (located
        (obj2 (req None None "expected_kinds" % string (list None kind_enc))
          (req None None "wrong_kind" % string kind_enc)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
            loc exp got => Some (loc, (exp, got))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (exp, got)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_kind
          loc exp got) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_primitive_namespace" % string
      "Invalid primitive namespace" % string
      "In a script or data expression, a primitive was of the wrong namespace."
        % string None
      (located
        (obj3 (req None None "primitive_name" % string prim_encoding)
          (req None None "expected_namespace" % string namespace_enc)
          (req None None "wrong_namespace" % string namespace_enc)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_namespace
            loc name exp got => Some (loc, (name, exp, got))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (name, exp, got)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_namespace
          loc name exp got) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.duplicate_script_field" % string
      "Script has a duplicated field (parse error)" % string
      "When parsing script, a field was found more than once" % string None
      (obj2 (req None None "loc" % string location_encoding)
        (req None None "prim" % string prim_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_field
            loc prim => Some (loc, prim)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, prim) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_field
          loc prim) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.unexpected_bigmap" % string
      "Big map in unauthorized position (type error)" % string
      "When parsing script, a big_map type was found in a position where it could end up stored inside a big_map, which is forbidden for now."
        % string None (obj1 (req None None "loc" % string location_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_big_map
            loc => Some loc
        | _ => None
        end)
      (fun loc =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_big_map
          loc) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.unexpected_operation" % string
      "Operation in unauthorized position (type error)" % string
      "When parsing script, an operation type was found in the storage or parameter field."
        % string None (obj1 (req None None "loc" % string location_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_operation
            loc => Some loc
        | _ => None
        end)
      (fun loc =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_operation
          loc) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.no_such_entrypoint" % string
      "No such entrypoint (type error)" % string
      "An entrypoint was not found when calling a contract." % string None
      (obj1 (req None None "entrypoint" % string string))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.No_such_entrypoint
            entrypoint => Some entrypoint
        | _ => None
        end)
      (fun entrypoint =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.No_such_entrypoint
          entrypoint) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.unreachable_entrypoint" % string
      "Unreachable entrypoint (type error)" % string
      "An entrypoint in the contract is not reachable." % string None
      (obj1 (req None None "path" % string (list None prim_encoding)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unreachable_entrypoint
            path => Some path
        | _ => None
        end)
      (fun path =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unreachable_entrypoint
          path) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.duplicate_entrypoint" % string
      "Duplicate entrypoint (type error)" % string
      "Two entrypoints have the same name." % string None
      (obj1 (req None None "path" % string string))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_entrypoint
            entrypoint => Some entrypoint
        | _ => None
        end)
      (fun entrypoint =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_entrypoint
          entrypoint) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.entrypoint_name_too_long" % string
      "Entrypoint name too long (type error)" % string
      "An entrypoint name exceeds the maximum length of 31 characters." % string
      None (obj1 (req None None "name" % string string))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Entrypoint_name_too_long
            entrypoint => Some entrypoint
        | _ => None
        end)
      (fun entrypoint =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Entrypoint_name_too_long
          entrypoint) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.unexpected_contract" % string
      "Contract in unauthorized position (type error)" % string
      "When parsing script, a contract type was found in the storage or parameter field."
        % string None (obj1 (req None None "loc" % string location_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_contract
            loc => Some loc
        | _ => None
        end)
      (fun loc =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_contract
          loc) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.unordered_map_literal" % string
      "Invalid map key order" % string
      "Map keys must be in strictly increasing order" % string None
      (obj2 (req None None "location" % string Script.location_encoding)
        (req None None "item" % string Script.expr_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unordered_map_keys
            loc expr => Some (loc, expr)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, expr) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unordered_map_keys
          loc expr) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.duplicate_map_keys" % string
      "Duplicate map keys" % string
      "Map literals cannot contain duplicated keys" % string None
      (obj2 (req None None "location" % string Script.location_encoding)
        (req None None "item" % string Script.expr_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_map_keys
            loc expr => Some (loc, expr)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, expr) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_map_keys
          loc expr) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.unordered_set_literal" % string
      "Invalid set value order" % string
      "Set values must be in strictly increasing order" % string None
      (obj2 (req None None "location" % string Script.location_encoding)
        (req None None "value" % string Script.expr_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unordered_set_values
            loc expr => Some (loc, expr)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, expr) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unordered_set_values
          loc expr) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.duplicate_set_values_in_literal" % string
      "Sets literals cannot contain duplicate elements" % string
      "Set literals cannot contain duplicate elements, but a duplicae was found while parsing."
        % string None
      (obj2 (req None None "location" % string Script.location_encoding)
        (req None None "value" % string Script.expr_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_set_values
            loc expr => Some (loc, expr)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, expr) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_set_values
          loc expr) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.fail_not_in_tail_position" % string
      "FAIL not in tail position" % string
      "There is non trivial garbage code after a FAIL instruction." % string
      None (located empty)
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Fail_not_in_tail_position
            loc => Some (loc, tt)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, tt) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Fail_not_in_tail_position
          loc) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.undefined_binop" % string "Undefined binop" % string
      "A binary operation is called on operands of types over which it is not defined."
        % string None
      (located
        (obj3 (req None None "operator_name" % string prim_encoding)
          (req None None "wrong_left_operand_type" % string Script.expr_encoding)
          (req None None "wrong_right_operand_type" % string
            Script.expr_encoding)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Undefined_binop
            loc n tyl tyr => Some (loc, (n, tyl, tyr))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (n, tyl, tyr)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Undefined_binop
          loc n tyl tyr) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.undefined_unop" % string "Undefined unop" % string
      "A unary operation is called on an operand of type over which it is not defined."
        % string None
      (located
        (obj2 (req None None "operator_name" % string prim_encoding)
          (req None None "wrong_operand_type" % string Script.expr_encoding)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Undefined_unop
            loc n ty => Some (loc, (n, ty))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (n, ty)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Undefined_unop
          loc n ty) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.bad_return" % string "Bad return" % string
      "Unexpected stack at the end of a lambda or script." % string None
      (located
        (obj2
          (req None None "expected_return_type" % string Script.expr_encoding)
          (req None None "wrong_stack_type" % string stack_ty_enc)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_return
            loc sty ty => Some (loc, (ty, sty))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (ty, sty)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_return loc
          sty ty) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.bad_stack" % string "Bad stack" % string
      "The stack has an unexpected length or contents." % string None
      (located
        (obj3 (req None None "primitive_name" % string prim_encoding)
          (req None None "relevant_stack_portion" % string int16)
          (req None None "wrong_stack_type" % string stack_ty_enc)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack
            loc name s sty => Some (loc, (name, s, sty))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (name, s, sty)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack loc
          name s sty) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.inconsistent_annotations" % string
      "Annotations inconsistent between branches" % string
      "The annotations on two types could not be merged" % string None
      (obj2 (req None None "annot1" % string string)
        (req None None "annot2" % string string))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_annotations
            annot1 annot2 => Some (annot1, annot2)
        | _ => None
        end)
      (fun function_parameter =>
        let '(annot1, annot2) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_annotations
          annot1 annot2) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.inconsistent_field_annotations" % string
      "Annotations for field accesses is inconsistent" % string
      "The specified field does not match the field annotation in the type" %
        string None
      (obj2 (req None None "annot1" % string string)
        (req None None "annot2" % string string))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_field_annotations
            annot1 annot2 => Some (annot1, annot2)
        | _ => None
        end)
      (fun function_parameter =>
        let '(annot1, annot2) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_field_annotations
          annot1 annot2) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.inconsistent_type_annotations" % string
      "Types contain inconsistent annotations" % string
      "The two types contain annotations that do not match" % string None
      (located
        (obj2 (req None None "type1" % string Script.expr_encoding)
          (req None None "type2" % string Script.expr_encoding)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_type_annotations
            loc ty1 ty2 => Some (loc, (ty1, ty2))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (ty1, ty2)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_type_annotations
          loc ty1 ty2) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.unexpected_annotation" % string
      "An annotation was encountered where no annotation is expected" % string
      "A node in the syntax tree was impropperly annotated" % string None
      (located empty)
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
            loc => Some (loc, tt)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, tt) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_annotation
          loc) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.ungrouped_annotations" % string
      "Annotations of the same kind were found spread apart" % string
      "Annotations of the same kind must be grouped" % string None
      (located empty)
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Ungrouped_annotations
            loc => Some (loc, tt)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, tt) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Ungrouped_annotations
          loc) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.unmatched_branches" % string
      "Unmatched branches" % string
      "At the join point at the end of two code branches the stacks have inconsistent lengths or contents."
        % string None
      (located
        (obj2 (req None None "first_stack_type" % string stack_ty_enc)
          (req None None "other_stack_type" % string stack_ty_enc)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Unmatched_branches
            loc stya styb => Some (loc, (stya, styb))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (stya, styb)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unmatched_branches
          loc stya styb) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.bad_stack_item" % string "Bad stack item" % string
      "The type of a stack item is unexpected (this error is always accompanied by a more precise one)."
        % string None (obj1 (req None None "item_level" % string int16))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack_item
            n => Some n
        | _ => None
        end)
      (fun n =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack_item
          n) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.self_in_lambda" % string
      "SELF instruction in lambda" % string
      "A SELF instruction was encountered in a lambda expression." % string None
      (located empty)
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Self_in_lambda
            loc => Some (loc, tt)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, tt) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Self_in_lambda
          loc) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.inconsistent_stack_lengths" % string
      "Inconsistent stack lengths" % string
      "A stack was of an unexpected length (this error is always in the context of a located error)."
        % string None empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack_length
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Bad_stack_length)
    in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_constant" % string
      "Invalid constant" % string
      "A data expression was invalid for its expected type." % string None
      (located
        (obj2 (req None None "expected_type" % string Script.expr_encoding)
          (req None None "wrong_expression" % string Script.expr_encoding)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_constant
            loc expr ty => Some (loc, (ty, expr))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (ty, expr)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_constant
          loc expr ty) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "invalidSyntacticConstantError" % string
      "Invalid constant (parse error)" % string
      "A compile-time constant was invalid for its expected form." % string None
      (located
        (obj2 (req None None "expectedForm" % string Script.expr_encoding)
          (req None None "wrongExpression" % string Script.expr_encoding)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_constant
            loc expr ty => Some (loc, (ty, expr))
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, (ty, expr)) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_constant
          loc expr ty) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_contract" % string
      "Invalid contract" % string
      "A script or data expression references a contract that does not exist or assumes a wrong type for an existing contract."
        % string None
      (located (obj1 (req None None "contract" % string Contract.encoding)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_contract
            loc c => Some (loc, c)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, c) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_contract
          loc c) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_big_map" % string "Invalid big_map" % string
      "A script or data expression references a big_map that does not exist or assumes a wrong type for an existing big_map."
        % string None (located (obj1 (req None None "big_map" % string z)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_big_map
            loc c => Some (loc, c)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, c) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_big_map
          loc c) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.comparable_type_expected" % string
      "Comparable type expected" % string
      "A non comparable type was used in a place where only comparable types are accepted."
        % string None
      (located (obj1 (req None None "wrong_type" % string Script.expr_encoding)))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Comparable_type_expected
            loc ty => Some (loc, ty)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, ty) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Comparable_type_expected
          loc ty) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.inconsistent_types" % string
      "Inconsistent types" % string
      "This is the basic type clash error, that appears in several places where the equality of two types have to be proven, it is always accompanied with another error that provides more context."
        % string None
      (obj2 (req None None "first_type" % string Script.expr_encoding)
        (req None None "other_type" % string Script.expr_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_types
            tya tyb => Some (tya, tyb)
        | _ => None
        end)
      (fun function_parameter =>
        let '(tya, tyb) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_types
          tya tyb) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_map_body" % string
      "Invalid map body" % string
      "The body of a map block did not match the expected type" % string None
      (obj2 (req None None "loc" % string Script.location_encoding)
        (req None None "body_type" % string stack_ty_enc))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_map_body
            loc stack => Some (loc, stack)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, stack) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_map_body
          loc stack) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_map_block_fail" % string
      "FAIL instruction occurred as body of map block" % string
      "FAIL cannot be the only instruction in the body. The propper type of the return list cannot be inferred."
        % string None
      (obj1 (req None None "loc" % string Script.location_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_map_block_fail
            loc => Some loc
        | _ => None
        end)
      (fun loc =>
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_map_block_fail
          loc) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.invalid_iter_body" % string
      "ITER body returned wrong stack type" % string
      "The body of an ITER instruction must result in the same stack type as before the ITER."
        % string None
      (obj3 (req None None "loc" % string Script.location_encoding)
        (req None None "bef_stack" % string stack_ty_enc)
        (req None None "aft_stack" % string stack_ty_enc))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_iter_body
            loc bef aft => Some (loc, bef, aft)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, bef, aft) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_iter_body
          loc bef aft) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.type_too_large" % string
      "Stack item type too large" % string
      "An instruction generated a type larger than the limit." % string None
      (obj3 (req None None "loc" % string Script.location_encoding)
        (req None None "type_size" % string uint16)
        (req None None "maximum_type_size" % string uint16))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Type_too_large
            loc ts maxts => Some (loc, ts, maxts)
        | _ => None
        end)
      (fun function_parameter =>
        let '(loc, ts, maxts) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Type_too_large
          loc ts maxts) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.ill_typed_data" % string "Ill typed data" % string
      "The toplevel error thrown when trying to typecheck a data expression against a given type (always followed by more precise errors)."
        % string None
      (obj3 (opt None None "identifier" % string string)
        (req None None "expected_type" % string Script.expr_encoding)
        (req None None "ill_typed_expression" % string Script.expr_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_data
            name expr ty => Some (name, ty, expr)
        | _ => None
        end)
      (fun function_parameter =>
        let '(name, ty, expr) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_data
          name expr ty) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.ill_formed_type" % string "Ill formed type" % string
      "The toplevel error thrown when trying to parse a type expression (always followed by more precise errors)."
        % string None
      (obj3 (opt None None "identifier" % string string)
        (req None None "ill_formed_expression" % string Script.expr_encoding)
        (req None None "location" % string Script.location_encoding))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
            name expr loc => Some (name, expr, loc)
        | _ => None
        end)
      (fun function_parameter =>
        let '(name, expr, loc) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_formed_type
          name expr loc) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.ill_typed_contract" % string
      "Ill typed contract" % string
      "The toplevel error thrown when trying to typecheck a contract code against given input, output and storage types (always followed by more precise errors)."
        % string None
      (obj2 (req None None "ill_typed_code" % string Script.expr_encoding)
        (req None None "type_map" % string type_map_enc))
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_contract
            expr type_map => Some (expr, type_map)
        | _ => None
        end)
      (fun function_parameter =>
        let '(expr, type_map) := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Ill_typed_contract
          expr type_map) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "michelson_v1.cannot_serialize_error" % string
      "Not enough gas to serialize error" % string
      "The error was too big to be serialized with the provided gas" % string
      None Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_error
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Cannot_serialize_error)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "michelson_v1.deprecated_instruction" % string
    "Script is using a deprecated instruction" % string
    "A deprecated instruction usage is disallowed in newly created contracts" %
      string None (obj1 (req None None "prim" % string prim_encoding))
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Deprecated_instruction
          prim => Some prim
      | _ => None
      end)
    (fun prim =>
      Tezos_protocol_environment_alpha__Environment.Error_monad.Deprecated_instruction
        prim).
script_timestamp_repr.ml 3 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = Z.t

let compare = Z.compare

let of_int64 = Z.of_int64

let of_string x =
  match Time_repr.of_notation x with
  | None -> (
    try Some (Z.of_string x) with _ -> None )
  | Some time ->
      Some (of_int64 (Time_repr.to_seconds time))

let to_notation x =
  try
    let notation = Time_repr.to_notation (Time.of_seconds (Z.to_int64 x)) in
    if String.equal notation "out_of_range" then None else Some notation
  with _ -> None

let to_num_str = Z.to_string

let to_string x = match to_notation x with None -> to_num_str x | Some s -> s

let diff x y = Script_int_repr.of_zint @@ Z.sub x y

let sub_delta t delta = Z.sub t (Script_int_repr.to_zint delta)

let add_delta t delta = Z.add t (Script_int_repr.to_zint delta)

let to_zint x = x

let of_zint x = x
script_timestamp_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition t := Tezos_protocol_environment_alpha__Environment.Z.t.

Definition compare
  : Tezos_protocol_environment_alpha__Environment.Z.t ->
    Tezos_protocol_environment_alpha__Environment.Z.t -> Z := Z.compare.

Definition of_int64
  : int64 -> Tezos_protocol_environment_alpha__Environment.Z.t := Z.of_int64.

Definition of_string (x : string)
  : option Tezos_protocol_environment_alpha__Environment.Z.t :=
  match Time_repr.of_notation x with
  | None =>
    (* ❌ Try-with are not handled *)
    try (Some (Z.of_string x))
  | Some time => Some (of_int64 (Time_repr.to_seconds time))
  end.

Definition to_notation (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  : option string :=
  (* ❌ Try-with are not handled *)
  try
    (let notation := Time_repr.to_notation (Time.of_seconds (Z.to_int64 x)) in
    if String.equal notation "out_of_range" % string then
      None
    else
      Some notation).

Definition to_num_str
  : Tezos_protocol_environment_alpha__Environment.Z.t -> string := Z.to_string.

Definition to_string (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  : string :=
  match to_notation x with
  | None => to_num_str x
  | Some s => s
  end.

Definition diff
  (x : Tezos_protocol_environment_alpha__Environment.Z.t)
  (y : Tezos_protocol_environment_alpha__Environment.Z.t)
  : Tezos_raw_protocol_alpha.Script_int_repr.num
    Tezos_raw_protocol_alpha.Script_int_repr.z :=
  op_atat Script_int_repr.of_zint (Z.sub x y).

Definition sub_delta {A : Type}
  (t : Tezos_protocol_environment_alpha__Environment.Z.t)
  (delta : Tezos_raw_protocol_alpha.Script_int_repr.num A)
  : Tezos_protocol_environment_alpha__Environment.Z.t :=
  Z.sub t (Script_int_repr.to_zint delta).

Definition add_delta {A : Type}
  (t : Tezos_protocol_environment_alpha__Environment.Z.t)
  (delta : Tezos_raw_protocol_alpha.Script_int_repr.num A)
  : Tezos_protocol_environment_alpha__Environment.Z.t :=
  Z.add t (Script_int_repr.to_zint delta).

Definition to_zint {A : Type} (x : A) : A := x.

Definition of_zint {A : Type} (x : A) : A := x.
script_timestamp_repr.mli 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Script_int_repr

type t

val of_int64 : int64 -> t

val compare : t -> t -> int

(* Convert a timestamp to a notation if possible *)
val to_notation : t -> string option

(* Convert a timestamp to a string representation of the seconds *)
val to_num_str : t -> string

(* Convert to a notation if possible, or num if not *)
val to_string : t -> string

val of_string : string -> t option

val diff : t -> t -> z num

val add_delta : t -> z num -> t

val sub_delta : t -> z num -> t

val to_zint : t -> Z.t

val of_zint : Z.t -> t
script_timestamp_repr_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter t : Type.

Parameter of_int64 : int64 -> t.

Parameter compare : t -> t -> Z.

Parameter to_notation : t -> option string.

Parameter to_num_str : t -> string.

Parameter to_string : t -> string.

Parameter of_string : string -> option t.

Parameter diff :
t ->
  t ->
    Tezos_raw_protocol_alpha.Script_int_repr.num
      Tezos_raw_protocol_alpha.Script_int_repr.z.

Parameter add_delta :
t ->
  Tezos_raw_protocol_alpha.Script_int_repr.num
    Tezos_raw_protocol_alpha.Script_int_repr.z -> t.

Parameter sub_delta :
t ->
  Tezos_raw_protocol_alpha.Script_int_repr.num
    Tezos_raw_protocol_alpha.Script_int_repr.z -> t.

Parameter to_zint : t -> Tezos_protocol_environment_alpha__Environment.Z.t.

Parameter of_zint : Tezos_protocol_environment_alpha__Environment.Z.t -> t.
script_typed_ir.ml 5 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context
open Script_int

(* ---- Auxiliary types -----------------------------------------------------*)

type var_annot = [`Var_annot of string]

type type_annot = [`Type_annot of string]

type field_annot = [`Field_annot of string]

type annot = [var_annot | type_annot | field_annot]

type address = Contract.t * string

type ('a, 'b) pair = 'a * 'b

type ('a, 'b) union = L of 'a | R of 'b

type comb = Comb

type leaf = Leaf

type (_, _) comparable_struct =
  | Int_key : type_annot option -> (z num, _) comparable_struct
  | Nat_key : type_annot option -> (n num, _) comparable_struct
  | String_key : type_annot option -> (string, _) comparable_struct
  | Bytes_key : type_annot option -> (MBytes.t, _) comparable_struct
  | Mutez_key : type_annot option -> (Tez.t, _) comparable_struct
  | Bool_key : type_annot option -> (bool, _) comparable_struct
  | Key_hash_key : type_annot option -> (public_key_hash, _) comparable_struct
  | Timestamp_key :
      type_annot option
      -> (Script_timestamp.t, _) comparable_struct
  | Address_key : type_annot option -> (address, _) comparable_struct
  | Pair_key :
      (('a, leaf) comparable_struct * field_annot option)
      * (('b, _) comparable_struct * field_annot option)
      * type_annot option
      -> (('a, 'b) pair, comb) comparable_struct

type 'a comparable_ty = ('a, comb) comparable_struct

module type Boxed_set = sig
  type elt

  val elt_ty : elt comparable_ty

  module OPS : S.SET with type elt = elt

  val boxed : OPS.t

  val size : int
end

type 'elt set = (module Boxed_set with type elt = 'elt)

module type Boxed_map = sig
  type key

  type value

  val key_ty : key comparable_ty

  module OPS : S.MAP with type key = key

  val boxed : value OPS.t * int
end

type ('key, 'value) map =
  (module Boxed_map with type key = 'key and type value = 'value)

type operation = packed_internal_operation * Contract.big_map_diff option

type ('arg, 'storage) script = {
  code : (('arg, 'storage) pair, (operation list, 'storage) pair) lambda;
  arg_type : 'arg ty;
  storage : 'storage;
  storage_type : 'storage ty;
  root_name : string option;
}

and end_of_stack = unit

and ('arg, 'ret) lambda =
  | Lam :
      ('arg * end_of_stack, 'ret * end_of_stack) descr * Script.node
      -> ('arg, 'ret) lambda

and 'arg typed_contract = 'arg ty * address

and 'ty ty =
  | Unit_t : type_annot option -> unit ty
  | Int_t : type_annot option -> z num ty
  | Nat_t : type_annot option -> n num ty
  | Signature_t : type_annot option -> signature ty
  | String_t : type_annot option -> string ty
  | Bytes_t : type_annot option -> MBytes.t ty
  | Mutez_t : type_annot option -> Tez.t ty
  | Key_hash_t : type_annot option -> public_key_hash ty
  | Key_t : type_annot option -> public_key ty
  | Timestamp_t : type_annot option -> Script_timestamp.t ty
  | Address_t : type_annot option -> address ty
  | Bool_t : type_annot option -> bool ty
  | Pair_t :
      ('a ty * field_annot option * var_annot option)
      * ('b ty * field_annot option * var_annot option)
      * type_annot option
      * bool
      -> ('a, 'b) pair ty
  | Union_t :
      ('a ty * field_annot option)
      * ('b ty * field_annot option)
      * type_annot option
      * bool
      -> ('a, 'b) union ty
  | Lambda_t : 'arg ty * 'ret ty * type_annot option -> ('arg, 'ret) lambda ty
  | Option_t : 'v ty * type_annot option * bool -> 'v option ty
  | List_t : 'v ty * type_annot option * bool -> 'v list ty
  | Set_t : 'v comparable_ty * type_annot option -> 'v set ty
  | Map_t :
      'k comparable_ty * 'v ty * type_annot option * bool
      -> ('k, 'v) map ty
  | Big_map_t :
      'k comparable_ty * 'v ty * type_annot option
      -> ('k, 'v) big_map ty
  | Contract_t : 'arg ty * type_annot option -> 'arg typed_contract ty
  | Operation_t : type_annot option -> operation ty
  | Chain_id_t : type_annot option -> Chain_id.t ty

and 'ty stack_ty =
  | Item_t :
      'ty ty * 'rest stack_ty * var_annot option
      -> ('ty * 'rest) stack_ty
  | Empty_t : end_of_stack stack_ty

and ('key, 'value) big_map = {
  id : Z.t option;
  diff : ('key, 'value option) map;
  key_type : 'key ty;
  value_type : 'value ty;
}

(* ---- Instructions --------------------------------------------------------*)

(* The low-level, typed instructions, as a GADT whose parameters
   encode the typing rules.

   The left parameter is the typed shape of the stack before the
   instruction, the right one the shape after. Any program whose
   construction is accepted by OCaml's type-checker is guaranteed to
   be type-safe. Overloadings of the concrete syntax are already
   resolved in this representation, either by using different
   constructors or type witness parameters. *)
and ('bef, 'aft) instr =
  (* stack ops *)
  | Drop : (_ * 'rest, 'rest) instr
  | Dup : ('top * 'rest, 'top * ('top * 'rest)) instr
  | Swap : ('tip * ('top * 'rest), 'top * ('tip * 'rest)) instr
  | Const : 'ty -> ('rest, 'ty * 'rest) instr
  (* pairs *)
  | Cons_pair : ('car * ('cdr * 'rest), ('car, 'cdr) pair * 'rest) instr
  | Car : (('car, _) pair * 'rest, 'car * 'rest) instr
  | Cdr : ((_, 'cdr) pair * 'rest, 'cdr * 'rest) instr
  (* options *)
  | Cons_some : ('v * 'rest, 'v option * 'rest) instr
  | Cons_none : 'a ty -> ('rest, 'a option * 'rest) instr
  | If_none :
      ('bef, 'aft) descr * ('a * 'bef, 'aft) descr
      -> ('a option * 'bef, 'aft) instr
  (* unions *)
  | Left : ('l * 'rest, ('l, 'r) union * 'rest) instr
  | Right : ('r * 'rest, ('l, 'r) union * 'rest) instr
  | If_left :
      ('l * 'bef, 'aft) descr * ('r * 'bef, 'aft) descr
      -> (('l, 'r) union * 'bef, 'aft) instr
  (* lists *)
  | Cons_list : ('a * ('a list * 'rest), 'a list * 'rest) instr
  | Nil : ('rest, 'a list * 'rest) instr
  | If_cons :
      ('a * ('a list * 'bef), 'aft) descr * ('bef, 'aft) descr
      -> ('a list * 'bef, 'aft) instr
  | List_map :
      ('a * 'rest, 'b * 'rest) descr
      -> ('a list * 'rest, 'b list * 'rest) instr
  | List_iter : ('a * 'rest, 'rest) descr -> ('a list * 'rest, 'rest) instr
  | List_size : ('a list * 'rest, n num * 'rest) instr
  (* sets *)
  | Empty_set : 'a comparable_ty -> ('rest, 'a set * 'rest) instr
  | Set_iter : ('a * 'rest, 'rest) descr -> ('a set * 'rest, 'rest) instr
  | Set_mem : ('elt * ('elt set * 'rest), bool * 'rest) instr
  | Set_update : ('elt * (bool * ('elt set * 'rest)), 'elt set * 'rest) instr
  | Set_size : ('a set * 'rest, n num * 'rest) instr
  (* maps *)
  | Empty_map : 'a comparable_ty * 'v ty -> ('rest, ('a, 'v) map * 'rest) instr
  | Map_map :
      (('a * 'v) * 'rest, 'r * 'rest) descr
      -> (('a, 'v) map * 'rest, ('a, 'r) map * 'rest) instr
  | Map_iter :
      (('a * 'v) * 'rest, 'rest) descr
      -> (('a, 'v) map * 'rest, 'rest) instr
  | Map_mem : ('a * (('a, 'v) map * 'rest), bool * 'rest) instr
  | Map_get : ('a * (('a, 'v) map * 'rest), 'v option * 'rest) instr
  | Map_update
      : ('a * ('v option * (('a, 'v) map * 'rest)), ('a, 'v) map * 'rest) instr
  | Map_size : (('a, 'b) map * 'rest, n num * 'rest) instr
  (* big maps *)
  | Empty_big_map :
      'a comparable_ty * 'v ty
      -> ('rest, ('a, 'v) big_map * 'rest) instr
  | Big_map_mem : ('a * (('a, 'v) big_map * 'rest), bool * 'rest) instr
  | Big_map_get : ('a * (('a, 'v) big_map * 'rest), 'v option * 'rest) instr
  | Big_map_update
      : ( 'key * ('value option * (('key, 'value) big_map * 'rest)),
          ('key, 'value) big_map * 'rest )
        instr
  (* string operations *)
  | Concat_string : (string list * 'rest, string * 'rest) instr
  | Concat_string_pair : (string * (string * 'rest), string * 'rest) instr
  | Slice_string
      : (n num * (n num * (string * 'rest)), string option * 'rest) instr
  | String_size : (string * 'rest, n num * 'rest) instr
  (* bytes operations *)
  | Concat_bytes : (MBytes.t list * 'rest, MBytes.t * 'rest) instr
  | Concat_bytes_pair : (MBytes.t * (MBytes.t * 'rest), MBytes.t * 'rest) instr
  | Slice_bytes
      : (n num * (n num * (MBytes.t * 'rest)), MBytes.t option * 'rest) instr
  | Bytes_size : (MBytes.t * 'rest, n num * 'rest) instr
  (* timestamp operations *)
  | Add_seconds_to_timestamp
      : ( z num * (Script_timestamp.t * 'rest),
          Script_timestamp.t * 'rest )
        instr
  | Add_timestamp_to_seconds
      : ( Script_timestamp.t * (z num * 'rest),
          Script_timestamp.t * 'rest )
        instr
  | Sub_timestamp_seconds
      : ( Script_timestamp.t * (z num * 'rest),
          Script_timestamp.t * 'rest )
        instr
  | Diff_timestamps
      : ( Script_timestamp.t * (Script_timestamp.t * 'rest),
          z num * 'rest )
        instr
  (* tez operations *)
  | Add_tez : (Tez.t * (Tez.t * 'rest), Tez.t * 'rest) instr
  | Sub_tez : (Tez.t * (Tez.t * 'rest), Tez.t * 'rest) instr
  | Mul_teznat : (Tez.t * (n num * 'rest), Tez.t * 'rest) instr
  | Mul_nattez : (n num * (Tez.t * 'rest), Tez.t * 'rest) instr
  | Ediv_teznat
      : (Tez.t * (n num * 'rest), (Tez.t, Tez.t) pair option * 'rest) instr
  | Ediv_tez
      : (Tez.t * (Tez.t * 'rest), (n num, Tez.t) pair option * 'rest) instr
  (* boolean operations *)
  | Or : (bool * (bool * 'rest), bool * 'rest) instr
  | And : (bool * (bool * 'rest), bool * 'rest) instr
  | Xor : (bool * (bool * 'rest), bool * 'rest) instr
  | Not : (bool * 'rest, bool * 'rest) instr
  (* integer operations *)
  | Is_nat : (z num * 'rest, n num option * 'rest) instr
  | Neg_nat : (n num * 'rest, z num * 'rest) instr
  | Neg_int : (z num * 'rest, z num * 'rest) instr
  | Abs_int : (z num * 'rest, n num * 'rest) instr
  | Int_nat : (n num * 'rest, z num * 'rest) instr
  | Add_intint : (z num * (z num * 'rest), z num * 'rest) instr
  | Add_intnat : (z num * (n num * 'rest), z num * 'rest) instr
  | Add_natint : (n num * (z num * 'rest), z num * 'rest) instr
  | Add_natnat : (n num * (n num * 'rest), n num * 'rest) instr
  | Sub_int : ('s num * ('t num * 'rest), z num * 'rest) instr
  | Mul_intint : (z num * (z num * 'rest), z num * 'rest) instr
  | Mul_intnat : (z num * (n num * 'rest), z num * 'rest) instr
  | Mul_natint : (n num * (z num * 'rest), z num * 'rest) instr
  | Mul_natnat : (n num * (n num * 'rest), n num * 'rest) instr
  | Ediv_intint
      : (z num * (z num * 'rest), (z num, n num) pair option * 'rest) instr
  | Ediv_intnat
      : (z num * (n num * 'rest), (z num, n num) pair option * 'rest) instr
  | Ediv_natint
      : (n num * (z num * 'rest), (z num, n num) pair option * 'rest) instr
  | Ediv_natnat
      : (n num * (n num * 'rest), (n num, n num) pair option * 'rest) instr
  | Lsl_nat : (n num * (n num * 'rest), n num * 'rest) instr
  | Lsr_nat : (n num * (n num * 'rest), n num * 'rest) instr
  | Or_nat : (n num * (n num * 'rest), n num * 'rest) instr
  | And_nat : (n num * (n num * 'rest), n num * 'rest) instr
  | And_int_nat : (z num * (n num * 'rest), n num * 'rest) instr
  | Xor_nat : (n num * (n num * 'rest), n num * 'rest) instr
  | Not_nat : (n num * 'rest, z num * 'rest) instr
  | Not_int : (z num * 'rest, z num * 'rest) instr
  (* control *)
  | Seq : ('bef, 'trans) descr * ('trans, 'aft) descr -> ('bef, 'aft) instr
  | If : ('bef, 'aft) descr * ('bef, 'aft) descr -> (bool * 'bef, 'aft) instr
  | Loop : ('rest, bool * 'rest) descr -> (bool * 'rest, 'rest) instr
  | Loop_left :
      ('a * 'rest, ('a, 'b) union * 'rest) descr
      -> (('a, 'b) union * 'rest, 'b * 'rest) instr
  | Dip : ('bef, 'aft) descr -> ('top * 'bef, 'top * 'aft) instr
  | Exec : ('arg * (('arg, 'ret) lambda * 'rest), 'ret * 'rest) instr
  | Apply :
      'arg ty
      -> ( 'arg * (('arg * 'remaining, 'ret) lambda * 'rest),
           ('remaining, 'ret) lambda * 'rest )
         instr
  | Lambda : ('arg, 'ret) lambda -> ('rest, ('arg, 'ret) lambda * 'rest) instr
  | Failwith : 'a ty -> ('a * 'rest, 'aft) instr
  | Nop : ('rest, 'rest) instr
  (* comparison *)
  | Compare : 'a comparable_ty -> ('a * ('a * 'rest), z num * 'rest) instr
  (* comparators *)
  | Eq : (z num * 'rest, bool * 'rest) instr
  | Neq : (z num * 'rest, bool * 'rest) instr
  | Lt : (z num * 'rest, bool * 'rest) instr
  | Gt : (z num * 'rest, bool * 'rest) instr
  | Le : (z num * 'rest, bool * 'rest) instr
  | Ge : (z num * 'rest, bool * 'rest) instr
  (* protocol *)
  | Address : (_ typed_contract * 'rest, address * 'rest) instr
  | Contract :
      'p ty * string
      -> (address * 'rest, 'p typed_contract option * 'rest) instr
  | Transfer_tokens
      : ( 'arg * (Tez.t * ('arg typed_contract * 'rest)),
          operation * 'rest )
        instr
  | Create_account
      : ( public_key_hash * (public_key_hash option * (bool * (Tez.t * 'rest))),
          operation * (address * 'rest) )
        instr
  | Implicit_account
      : (public_key_hash * 'rest, unit typed_contract * 'rest) instr
  | Create_contract :
      'g ty * 'p ty * ('p * 'g, operation list * 'g) lambda * string option
      -> ( public_key_hash
           * (public_key_hash option * (bool * (bool * (Tez.t * ('g * 'rest))))),
           operation * (address * 'rest) )
         instr
  | Create_contract_2 :
      'g ty * 'p ty * ('p * 'g, operation list * 'g) lambda * string option
      -> ( public_key_hash option * (Tez.t * ('g * 'rest)),
           operation * (address * 'rest) )
         instr
  | Set_delegate : (public_key_hash option * 'rest, operation * 'rest) instr
  | Now : ('rest, Script_timestamp.t * 'rest) instr
  | Balance : ('rest, Tez.t * 'rest) instr
  | Check_signature
      : (public_key * (signature * (MBytes.t * 'rest)), bool * 'rest) instr
  | Hash_key : (public_key * 'rest, public_key_hash * 'rest) instr
  | Pack : 'a ty -> ('a * 'rest, MBytes.t * 'rest) instr
  | Unpack : 'a ty -> (MBytes.t * 'rest, 'a option * 'rest) instr
  | Blake2b : (MBytes.t * 'rest, MBytes.t * 'rest) instr
  | Sha256 : (MBytes.t * 'rest, MBytes.t * 'rest) instr
  | Sha512 : (MBytes.t * 'rest, MBytes.t * 'rest) instr
  | Steps_to_quota
      : (* TODO: check that it always returns a nat *)
      ('rest, n num * 'rest) instr
  | Source : ('rest, address * 'rest) instr
  | Sender : ('rest, address * 'rest) instr
  | Self : 'p ty * string -> ('rest, 'p typed_contract * 'rest) instr
  | Amount : ('rest, Tez.t * 'rest) instr
  | Dig :
      int * ('x * 'rest, 'rest, 'bef, 'aft) stack_prefix_preservation_witness
      -> ('bef, 'x * 'aft) instr
  | Dug :
      int * ('rest, 'x * 'rest, 'bef, 'aft) stack_prefix_preservation_witness
      -> ('x * 'bef, 'aft) instr
  | Dipn :
      int
      * ('fbef, 'faft, 'bef, 'aft) stack_prefix_preservation_witness
      * ('fbef, 'faft) descr
      -> ('bef, 'aft) instr
  | Dropn :
      int * ('rest, 'rest, 'bef, _) stack_prefix_preservation_witness
      -> ('bef, 'rest) instr
  | ChainId : ('rest, Chain_id.t * 'rest) instr

(* Type witness for operations that work deep in the stack ignoring
   (and preserving) a prefix.

   The two right parameters are the shape of the stack with the (same)
   prefix before and after the transformation. The two left
   parameters are the shape of the stack without the prefix before and
   after. The inductive definition makes it so by construction. *)
and ('bef, 'aft, 'bef_suffix, 'aft_suffix) stack_prefix_preservation_witness =
  | Prefix :
      ('fbef, 'faft, 'bef, 'aft) stack_prefix_preservation_witness
      -> ('fbef, 'faft, 'x * 'bef, 'x * 'aft) stack_prefix_preservation_witness
  | Rest : ('bef, 'aft, 'bef, 'aft) stack_prefix_preservation_witness

and ('bef, 'aft) descr = {
  loc : Script.location;
  bef : 'bef stack_ty;
  aft : 'aft stack_ty;
  instr : ('bef, 'aft) instr;
}

type ex_big_map = Ex_bm : ('key, 'value) big_map -> ex_big_map
script_typed_ir_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Import Script_int.

Definition var_annot := variant.

Definition type_annot := variant.

Definition field_annot := variant.

Definition annot := variant.

Definition address :=
  Tezos_raw_protocol_alpha.Alpha_context.Contract.t * string.

Definition pair (a b : Type) := a * b.

Inductive union (a b : Type) : Type :=
| L : a -> union a b
| R : b -> union a b.

Arguments L {_ _}.
Arguments R {_ _}.

Inductive comb : Type :=
| Comb : comb.

Inductive leaf : Type :=
| Leaf : leaf.

Reserved Notation "'comparable_struct".

Inductive comparable_struct_gadt : Type :=
| Int_key : option type_annot -> comparable_struct_gadt
| Nat_key : option type_annot -> comparable_struct_gadt
| String_key : option type_annot -> comparable_struct_gadt
| Bytes_key : option type_annot -> comparable_struct_gadt
| Mutez_key : option type_annot -> comparable_struct_gadt
| Bool_key : option type_annot -> comparable_struct_gadt
| Key_hash_key : option type_annot -> comparable_struct_gadt
| Timestamp_key : option type_annot -> comparable_struct_gadt
| Address_key : option type_annot -> comparable_struct_gadt
| Pair_key : comparable_struct_gadt * option field_annot ->
  comparable_struct_gadt * option field_annot -> option type_annot ->
  comparable_struct_gadt

where "'comparable_struct" := (fun (_ _ : Type) => comparable_struct_gadt).

Definition comparable_struct := 'comparable_struct.

Definition comparable_ty (a : Type) := comparable_struct a comb.

Module Boxed_set.
  Record signature {elt OPS_t : Type} := {
    elt := elt;
    elt_ty : comparable_ty elt;
    OPS : S.SET.signature elt OPS_t;
    boxed : OPS.(Tezos_protocol_environment_alpha__Environment.S.SET.t);
    size : Z;
  }.
  Arguments signature : clear implicits.
End Boxed_set.

Definition set (elt : Type) := {OPS_t : _ & Boxed_set.signature elt OPS_t}.

Module Boxed_map.
  Record signature {key value OPS_t : Type} := {
    key := key;
    value := value;
    key_ty : comparable_ty key;
    OPS : S.MAP.signature key OPS_t;
    boxed : OPS.(Tezos_protocol_environment_alpha__Environment.S.MAP.t) value *
      Z;
  }.
  Arguments signature : clear implicits.
End Boxed_map.

Definition map (key value : Type) :=
  {OPS_t : _ & Boxed_map.signature key value OPS_t}.

Definition operation :=
  Tezos_raw_protocol_alpha.Alpha_context.packed_internal_operation *
    option Tezos_raw_protocol_alpha.Alpha_context.Contract.big_map_diff.

Reserved Notation "'script".
Reserved Notation "'end_of_stack".
Reserved Notation "'lambda".
Reserved Notation "'typed_contract".
Reserved Notation "'ty".
Reserved Notation "'stack_ty".
Reserved Notation "'big_map".
Reserved Notation "'instr".
Reserved Notation "'stack_prefix_preservation_witness".
Reserved Notation "'descr".

Record descr_skeleton {loc bef aft instr : Type} := {
  loc : loc;
  bef : bef;
  aft : aft;
  instr : instr }.
Arguments descr_skeleton : clear implicits.

Record big_map_skeleton {id diff key_type value_type : Type} := {
  id : id;
  diff : diff;
  key_type : key_type;
  value_type : value_type }.
Arguments big_map_skeleton : clear implicits.

Record script_skeleton {code arg_type storage storage_type root_name : Type} :=
  {
  code : code;
  arg_type : arg_type;
  storage : storage;
  storage_type : storage_type;
  root_name : root_name }.
Arguments script_skeleton : clear implicits.

Inductive lambda_gadt : Type :=
| Lam : forall {arg ret : Type},
  'descr (arg * 'end_of_stack) (ret * 'end_of_stack) ->
  Tezos_raw_protocol_alpha.Alpha_context.Script.node -> lambda_gadt

with ty_gadt : Type :=
| Unit_t : option type_annot -> ty_gadt
| Int_t : option type_annot -> ty_gadt
| Nat_t : option type_annot -> ty_gadt
| Signature_t : option type_annot -> ty_gadt
| String_t : option type_annot -> ty_gadt
| Bytes_t : option type_annot -> ty_gadt
| Mutez_t : option type_annot -> ty_gadt
| Key_hash_t : option type_annot -> ty_gadt
| Key_t : option type_annot -> ty_gadt
| Timestamp_t : option type_annot -> ty_gadt
| Address_t : option type_annot -> ty_gadt
| Bool_t : option type_annot -> ty_gadt
| Pair_t : ty_gadt * option field_annot * option var_annot ->
  ty_gadt * option field_annot * option var_annot -> option type_annot -> bool
  -> ty_gadt
| Union_t : ty_gadt * option field_annot -> ty_gadt * option field_annot ->
  option type_annot -> bool -> ty_gadt
| Lambda_t : ty_gadt -> ty_gadt -> option type_annot -> ty_gadt
| Option_t : ty_gadt -> option type_annot -> bool -> ty_gadt
| List_t : ty_gadt -> option type_annot -> bool -> ty_gadt
| Set_t : forall {v : Type}, comparable_ty v -> option type_annot -> ty_gadt
| Map_t : forall {k : Type}, comparable_ty k -> ty_gadt -> option type_annot ->
  bool -> ty_gadt
| Big_map_t : forall {k : Type}, comparable_ty k -> ty_gadt -> option type_annot
  -> ty_gadt
| Contract_t : ty_gadt -> option type_annot -> ty_gadt
| Operation_t : option type_annot -> ty_gadt
| Chain_id_t : option type_annot -> ty_gadt

with stack_ty_gadt : Type :=
| Item_t : forall {ty : Type}, 'ty ty -> stack_ty_gadt -> option var_annot ->
  stack_ty_gadt
| Empty_t : stack_ty_gadt

with instr_gadt : Type :=
| Drop : instr_gadt
| Dup : instr_gadt
| Swap : instr_gadt
| Const : forall {ty : Type}, ty -> instr_gadt
| Cons_pair : instr_gadt
| Car : instr_gadt
| Cdr : instr_gadt
| Cons_some : instr_gadt
| Cons_none : forall {a : Type}, 'ty a -> instr_gadt
| If_none : forall {a aft bef : Type}, 'descr bef aft -> 'descr (a * bef) aft ->
  instr_gadt
| Left : instr_gadt
| Right : instr_gadt
| If_left : forall {aft bef l r : Type}, 'descr (l * bef) aft ->
  'descr (r * bef) aft -> instr_gadt
| Cons_list : instr_gadt
| Nil : instr_gadt
| If_cons : forall {a aft bef : Type}, 'descr (a * (list a * bef)) aft ->
  'descr bef aft -> instr_gadt
| List_map : forall {a b rest : Type}, 'descr (a * rest) (b * rest) ->
  instr_gadt
| List_iter : forall {a rest : Type}, 'descr (a * rest) rest -> instr_gadt
| List_size : instr_gadt
| Empty_set : forall {a : Type}, comparable_ty a -> instr_gadt
| Set_iter : forall {a rest : Type}, 'descr (a * rest) rest -> instr_gadt
| Set_mem : instr_gadt
| Set_update : instr_gadt
| Set_size : instr_gadt
| Empty_map : forall {a v : Type}, comparable_ty a -> 'ty v -> instr_gadt
| Map_map : forall {a r rest v : Type}, 'descr ((a * v) * rest) (r * rest) ->
  instr_gadt
| Map_iter : forall {a rest v : Type}, 'descr ((a * v) * rest) rest ->
  instr_gadt
| Map_mem : instr_gadt
| Map_get : instr_gadt
| Map_update : instr_gadt
| Map_size : instr_gadt
| Empty_big_map : forall {a v : Type}, comparable_ty a -> 'ty v -> instr_gadt
| Big_map_mem : instr_gadt
| Big_map_get : instr_gadt
| Big_map_update : instr_gadt
| Concat_string : instr_gadt
| Concat_string_pair : instr_gadt
| Slice_string : instr_gadt
| String_size : instr_gadt
| Concat_bytes : instr_gadt
| Concat_bytes_pair : instr_gadt
| Slice_bytes : instr_gadt
| Bytes_size : instr_gadt
| Add_seconds_to_timestamp : instr_gadt
| Add_timestamp_to_seconds : instr_gadt
| Sub_timestamp_seconds : instr_gadt
| Diff_timestamps : instr_gadt
| Add_tez : instr_gadt
| Sub_tez : instr_gadt
| Mul_teznat : instr_gadt
| Mul_nattez : instr_gadt
| Ediv_teznat : instr_gadt
| Ediv_tez : instr_gadt
| Or : instr_gadt
| And : instr_gadt
| Xor : instr_gadt
| Not : instr_gadt
| Is_nat : instr_gadt
| Neg_nat : instr_gadt
| Neg_int : instr_gadt
| Abs_int : instr_gadt
| Int_nat : instr_gadt
| Add_intint : instr_gadt
| Add_intnat : instr_gadt
| Add_natint : instr_gadt
| Add_natnat : instr_gadt
| Sub_int : instr_gadt
| Mul_intint : instr_gadt
| Mul_intnat : instr_gadt
| Mul_natint : instr_gadt
| Mul_natnat : instr_gadt
| Ediv_intint : instr_gadt
| Ediv_intnat : instr_gadt
| Ediv_natint : instr_gadt
| Ediv_natnat : instr_gadt
| Lsl_nat : instr_gadt
| Lsr_nat : instr_gadt
| Or_nat : instr_gadt
| And_nat : instr_gadt
| And_int_nat : instr_gadt
| Xor_nat : instr_gadt
| Not_nat : instr_gadt
| Not_int : instr_gadt
| Seq : forall {aft bef trans : Type}, 'descr bef trans -> 'descr trans aft ->
  instr_gadt
| If : forall {aft bef : Type}, 'descr bef aft -> 'descr bef aft -> instr_gadt
| Loop : forall {rest : Type}, 'descr rest (bool * rest) -> instr_gadt
| Loop_left : forall {a b rest : Type}, 'descr (a * rest) (union a b * rest) ->
  instr_gadt
| Dip : forall {aft bef : Type}, 'descr bef aft -> instr_gadt
| Exec : instr_gadt
| Apply : forall {arg : Type}, 'ty arg -> instr_gadt
| Lambda : forall {arg ret : Type}, 'lambda arg ret -> instr_gadt
| Failwith : forall {a : Type}, 'ty a -> instr_gadt
| Nop : instr_gadt
| Compare : forall {a : Type}, comparable_ty a -> instr_gadt
| Eq : instr_gadt
| Neq : instr_gadt
| Lt : instr_gadt
| Gt : instr_gadt
| Le : instr_gadt
| Ge : instr_gadt
| Address : instr_gadt
| Contract : forall {p : Type}, 'ty p -> string -> instr_gadt
| Transfer_tokens : instr_gadt
| Create_account : instr_gadt
| Implicit_account : instr_gadt
| Create_contract : forall {g p : Type}, 'ty g -> 'ty p ->
  'lambda (p * g) (list operation * g) -> option string -> instr_gadt
| Create_contract_2 : forall {g p : Type}, 'ty g -> 'ty p ->
  'lambda (p * g) (list operation * g) -> option string -> instr_gadt
| Set_delegate : instr_gadt
| Now : instr_gadt
| Balance : instr_gadt
| Check_signature : instr_gadt
| Hash_key : instr_gadt
| Pack : forall {a : Type}, 'ty a -> instr_gadt
| Unpack : forall {a : Type}, 'ty a -> instr_gadt
| Blake2b : instr_gadt
| Sha256 : instr_gadt
| Sha512 : instr_gadt
| Steps_to_quota : instr_gadt
| Source : instr_gadt
| Sender : instr_gadt
| Self : forall {p : Type}, 'ty p -> string -> instr_gadt
| Amount : instr_gadt
| Dig : forall {aft bef rest x : Type}, Z ->
  'stack_prefix_preservation_witness (x * rest) rest bef aft -> instr_gadt
| Dug : forall {aft bef rest x : Type}, Z ->
  'stack_prefix_preservation_witness rest (x * rest) bef aft -> instr_gadt
| Dipn : forall {aft bef faft fbef : Type}, Z ->
  'stack_prefix_preservation_witness fbef faft bef aft -> 'descr fbef faft ->
  instr_gadt
| Dropn : forall {C bef rest : Type}, Z ->
  'stack_prefix_preservation_witness rest rest bef C -> instr_gadt
| ChainId : instr_gadt

with stack_prefix_preservation_witness_gadt : Type :=
| Prefix : stack_prefix_preservation_witness_gadt ->
  stack_prefix_preservation_witness_gadt
| Rest : stack_prefix_preservation_witness_gadt

where "'script" := (fun (arg storage : Type) =>
  script_skeleton ('lambda (pair arg storage) (pair (list operation) storage))
    ('ty arg) storage ('ty storage) (option string))
and "'end_of_stack" := (unit)
and "'lambda" := (fun (arg ret : Type) => lambda_gadt)
and "'typed_contract" := (fun (arg : Type) => 'ty arg * address)
and "'ty" := (fun (ty : Type) => ty_gadt)
and "'stack_ty" := (fun (ty : Type) => stack_ty_gadt)
and "'big_map" := (fun (key value : Type) =>
  big_map_skeleton (option Tezos_protocol_environment_alpha__Environment.Z.t)
    (map key (option value)) ('ty key) ('ty value))
and "'instr" := (fun (bef aft : Type) => instr_gadt)
and "'stack_prefix_preservation_witness" := (fun
  (bef aft bef_suffix aft_suffix : Type) =>
  stack_prefix_preservation_witness_gadt)
and "'descr" := (fun (bef aft : Type) =>
  descr_skeleton Tezos_raw_protocol_alpha.Alpha_context.Script.location
    ('stack_ty bef) ('stack_ty aft) ('instr bef aft)).

Definition script := 'script.
Definition end_of_stack := 'end_of_stack.
Definition lambda := 'lambda.
Definition typed_contract := 'typed_contract.
Definition ty := 'ty.
Definition stack_ty := 'stack_ty.
Definition big_map := 'big_map.
Definition instr := 'instr.
Definition stack_prefix_preservation_witness :=
  'stack_prefix_preservation_witness.
Definition descr := 'descr.

Reserved Notation "'ex_big_map".

Inductive ex_big_map_gadt : Type :=
| Ex_bm : forall {key value : Type}, big_map key value -> ex_big_map_gadt

where "'ex_big_map" := (ex_big_map_gadt).

Definition ex_big_map := 'ex_big_map.
seed_repr.ml 13 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* Tezos Protocol Implementation - Random number generation *)

type seed = B of State_hash.t

type t = T of State_hash.t

type sequence = S of State_hash.t

type nonce = MBytes.t

let nonce_encoding = Data_encoding.Fixed.bytes Constants_repr.nonce_length

let init = "Laissez-faire les proprietaires."

let zero_bytes = MBytes.of_string (String.make Nonce_hash.size '\000')

let state_hash_encoding =
  let open Data_encoding in
  conv
    State_hash.to_bytes
    State_hash.of_bytes_exn
    (Fixed.bytes Nonce_hash.size)

let seed_encoding =
  let open Data_encoding in
  conv (fun (B b) -> b) (fun b -> B b) state_hash_encoding

let empty = B (State_hash.hash_bytes [MBytes.of_string init])

let nonce (B state) nonce =
  B (State_hash.hash_bytes [State_hash.to_bytes state; nonce])

let initialize_new (B state) append =
  T (State_hash.hash_bytes (State_hash.to_bytes state :: zero_bytes :: append))

let xor_higher_bits i b =
  let higher = MBytes.get_int32 b 0 in
  let r = Int32.logxor higher i in
  let res = MBytes.copy b in
  MBytes.set_int32 res 0 r ; res

let sequence (T state) n =
  State_hash.to_bytes state |> xor_higher_bits n
  |> fun b -> S (State_hash.hash_bytes [b])

let take (S state) =
  let b = State_hash.to_bytes state in
  let h = State_hash.hash_bytes [b] in
  (State_hash.to_bytes h, S h)

let take_int32 s bound =
  if Compare.Int32.(bound <= 0l) then invalid_arg "Seed_repr.take_int32"
    (* FIXME *)
  else
    let rec loop s =
      let (bytes, s) = take s in
      let r = Int32.abs (MBytes.get_int32 bytes 0) in
      let drop_if_over =
        Int32.sub Int32.max_int (Int32.rem Int32.max_int bound)
      in
      if Compare.Int32.(r >= drop_if_over) then loop s
      else
        let v = Int32.rem r bound in
        (v, s)
    in
    loop s

type error += Unexpected_nonce_length (* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"unexpected_nonce_length"
    ~title:"Unexpected nonce length"
    ~description:"Nonce length is incorrect."
    ~pp:(fun ppf () ->
      Format.fprintf
        ppf
        "Nonce length is not %i bytes long as it should."
        Constants_repr.nonce_length)
    Data_encoding.empty
    (function Unexpected_nonce_length -> Some () | _ -> None)
    (fun () -> Unexpected_nonce_length)

let make_nonce nonce =
  if Compare.Int.(MBytes.length nonce <> Constants_repr.nonce_length) then
    error Unexpected_nonce_length
  else ok nonce

let hash nonce = Nonce_hash.hash_bytes [nonce]

let check_hash nonce hash =
  Compare.Int.(MBytes.length nonce = Constants_repr.nonce_length)
  && Nonce_hash.equal (Nonce_hash.hash_bytes [nonce]) hash

let nonce_hash_key_part = Nonce_hash.to_path

let initial_nonce_0 = zero_bytes

let initial_nonce_hash_0 = hash initial_nonce_0

let deterministic_seed seed = nonce seed zero_bytes

let initial_seeds n =
  let rec loop acc elt i =
    if Compare.Int.(i = 1) then List.rev (elt :: acc)
    else loop (elt :: acc) (deterministic_seed elt) (i - 1)
  in
  loop [] (B (State_hash.hash_bytes [])) n
seed_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive seed : Type :=
| B : Tezos_raw_protocol_alpha.State_hash.t -> seed.

Inductive t : Type :=
| T : Tezos_raw_protocol_alpha.State_hash.t -> t.

Inductive sequence : Type :=
| S : Tezos_raw_protocol_alpha.State_hash.t -> sequence.

Definition nonce := Tezos_protocol_environment_alpha__Environment.MBytes.t.

Definition nonce_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    Tezos_protocol_environment_alpha__Environment.MBytes.t :=
  Data_encoding.Fixed.bytes Constants_repr.nonce_length.

Definition init : string := "Laissez-faire les proprietaires." % string.

Definition zero_bytes
  : Tezos_protocol_environment_alpha__Environment.MBytes.t :=
  MBytes.of_string (String.make Nonce_hash.size "000" % char).

Definition state_hash_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    Tezos_raw_protocol_alpha.State_hash.t :=
  conv State_hash.to_bytes State_hash.of_bytes_exn None
    (Fixed.bytes Nonce_hash.size).

Definition seed_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding seed :=
  conv
    (fun function_parameter =>
      let 'B b := function_parameter in
      b) (fun b => B b) None state_hash_encoding.

Definition empty : seed :=
  B (State_hash.hash_bytes None (cons (MBytes.of_string init) [])).

Definition nonce (function_parameter : seed)
  : Tezos_protocol_environment_alpha__Environment.MBytes.t -> seed :=
  let 'B state := function_parameter in
  fun nonce =>
    B
      (State_hash.hash_bytes None
        (cons (State_hash.to_bytes state) (cons nonce []))).

Definition initialize_new (function_parameter : seed)
  : list Tezos_protocol_environment_alpha__Environment.MBytes.t -> t :=
  let 'B state := function_parameter in
  fun append =>
    T
      (State_hash.hash_bytes None
        (cons (State_hash.to_bytes state) (cons zero_bytes append))).

Definition xor_higher_bits
  (i : int32) (b : Tezos_protocol_environment_alpha__Environment.MBytes.t)
  : Tezos_protocol_environment_alpha__Environment.MBytes.t :=
  let higher := MBytes.get_int32 b 0 in
  let r := Int32.logxor higher i in
  let res := MBytes.copy b in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := MBytes.set_int32 res 0 r in
  res.

Definition sequence (function_parameter : t) : int32 -> sequence :=
  let 'T state := function_parameter in
  fun n =>
    op_pipegt (op_pipegt (State_hash.to_bytes state) (xor_higher_bits n))
      (fun b => S (State_hash.hash_bytes None (cons b []))).

Definition take (function_parameter : sequence)
  : Tezos_protocol_environment_alpha__Environment.MBytes.t * sequence :=
  let 'S state := function_parameter in
  let b := State_hash.to_bytes state in
  let h := State_hash.hash_bytes None (cons b []) in
  ((State_hash.to_bytes h), (S h)).

Definition take_int32
  (s : sequence)
  (bound :
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : int32 * sequence :=
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lteq)
      bound
      (* ❌ Constant of type int32 is converted to int *)
      0 then
    invalid_arg "Seed_repr.take_int32" % string
  else
    let fix loop (s : sequence) : int32 * sequence :=
      let '(bytes, s) := take s in
      let r := Int32.abs (MBytes.get_int32 string 0) in
      let drop_if_over :=
        Int32.sub Int32.max_int (Int32.rem Int32.max_int bound) in
      if
        Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
          r drop_if_over then
        loop s
      else
        let v := Int32.rem r bound in
        (v, s) in
    loop s.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "unexpected_nonce_length" % string
    "Unexpected nonce length" % string "Nonce length is incorrect." % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "Nonce length is not " % string
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_i
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    " bytes long as it should." % string
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
              "Nonce length is not %i bytes long as it should." % string)
            Constants_repr.nonce_length)) Data_encoding.empty
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_nonce_length
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_nonce_length).

Definition make_nonce
  (nonce : Tezos_protocol_environment_alpha__Environment.MBytes.t)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    Tezos_protocol_environment_alpha__Environment.MBytes.t :=
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_ltgt)
      (MBytes.length nonce) Constants_repr.nonce_length then
    error
      Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_nonce_length
  else
    ok nonce.

Definition hash (nonce : Tezos_protocol_environment_alpha__Environment.MBytes.t)
  : Tezos_raw_protocol_alpha.Nonce_hash.t :=
  Nonce_hash.hash_bytes None (cons nonce []).

Definition check_hash
  (nonce : Tezos_protocol_environment_alpha__Environment.MBytes.t)
  (hash : Tezos_raw_protocol_alpha.Nonce_hash.t) : bool :=
  op_andand
    (Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
      (MBytes.length nonce) Constants_repr.nonce_length)
    (Nonce_hash.equal (Nonce_hash.hash_bytes None (cons nonce [])) hash).

Definition nonce_hash_key_part
  : Tezos_raw_protocol_alpha.Nonce_hash.t -> list string -> list string :=
  Nonce_hash.to_path.

Definition initial_nonce_0
  : Tezos_protocol_environment_alpha__Environment.MBytes.t := zero_bytes.

Definition initial_nonce_hash_0 : Tezos_raw_protocol_alpha.Nonce_hash.t :=
  hash initial_nonce_0.

Definition deterministic_seed (seed : seed) : seed := nonce seed zero_bytes.

Definition initial_seeds
  (n :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : list seed :=
  let fix loop
    (acc : list seed) (elt : seed) (i :
    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
    : list seed :=
    if
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
        i 1 then
      List.rev (cons elt acc)
    else
      loop (cons elt acc) (deterministic_seed elt) (op_minus i 1) in
  loop [] (B (State_hash.hash_bytes None [])) n.
seed_repr.mli 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Tezos Protocol Implementation - Random number generation

    This is not expected to be a good cryptographic random number
    generator. In particular this is supposed to be used in situations
    where the seed is a globaly known information.

    The only expected property is: It should be difficult to find a
    seed such that the generated sequence is a given one. *)

(** {2 Random Generation} *)

(** The state of the random number generator *)
type t

(** A random seed, to derive random sequences from *)
type seed

(** A random sequence, to derive random values from *)
type sequence

(** [initialize_new state ident] returns a new generator *)
val initialize_new : seed -> MBytes.t list -> t

(** [sequence state n] prepares the n-th sequence of a state  *)
val sequence : t -> int32 -> sequence

(** Generates the next random value in the sequence *)
val take : sequence -> MBytes.t * sequence

(** Generates the next random value as a bounded [int32] *)
val take_int32 : sequence -> int32 -> int32 * sequence

(** {2 Predefined seeds} *)

val empty : seed

(** Returns a new seed by hashing the one passed with a constant. *)
val deterministic_seed : seed -> seed

(** [intial_seeds n] generates the first [n] seeds for which there are no nonces.
    The first seed is a constant value. The kth seed is the hash of seed (k-1)
    concatenated with a constant. *)
val initial_seeds : int -> seed list

(** {2 Entropy} *)

(** A nonce for adding entropy to the generator *)
type nonce

(** Add entropy to the seed generator *)
val nonce : seed -> nonce -> seed

(** Use a byte sequence as a nonce *)
val make_nonce : MBytes.t -> nonce tzresult

(** Compute the has of a nonce *)
val hash : nonce -> Nonce_hash.t

(** [check_hash nonce hash] is true if the nonce correspond to the hash *)
val check_hash : nonce -> Nonce_hash.t -> bool

(** For using nonce hashes as keys in the hierarchical database *)
val nonce_hash_key_part : Nonce_hash.t -> string list -> string list

(** {2 Predefined nonce} *)

val initial_nonce_0 : nonce

val initial_nonce_hash_0 : Nonce_hash.t

(** {2 Serializers} *)

val nonce_encoding : nonce Data_encoding.t

val seed_encoding : seed Data_encoding.t
seed_repr_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter t : Type.

Parameter seed : Type.

Parameter sequence : Type.

Parameter initialize_new :
seed -> list Tezos_protocol_environment_alpha__Environment.MBytes.t -> t.

Parameter sequence : t -> int32 -> sequence.

Parameter take :
sequence -> Tezos_protocol_environment_alpha__Environment.MBytes.t * sequence.

Parameter take_int32 : sequence -> int32 -> int32 * sequence.

Parameter empty : seed.

Parameter deterministic_seed : seed -> seed.

Parameter initial_seeds : Z -> list seed.

Parameter nonce : Type.

Parameter nonce : seed -> nonce -> seed.

Parameter make_nonce :
Tezos_protocol_environment_alpha__Environment.MBytes.t ->
  Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult nonce.

Parameter hash : nonce -> Tezos_raw_protocol_alpha.Nonce_hash.t.

Parameter check_hash : nonce -> Tezos_raw_protocol_alpha.Nonce_hash.t -> bool.

Parameter nonce_hash_key_part :
Tezos_raw_protocol_alpha.Nonce_hash.t -> list string -> list string.

Parameter initial_nonce_0 : nonce.

Parameter initial_nonce_hash_0 : Tezos_raw_protocol_alpha.Nonce_hash.t.

Parameter nonce_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t nonce.

Parameter seed_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t seed.
seed_storage.ml 5 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Misc

type error +=
  | Unknown of {
      oldest : Cycle_repr.t;
      cycle : Cycle_repr.t;
      latest : Cycle_repr.t;
    }

(* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"seed.unknown_seed"
    ~title:"Unknown seed"
    ~description:"The requested seed is not available"
    ~pp:(fun ppf (oldest, cycle, latest) ->
      if Cycle_repr.(cycle < oldest) then
        Format.fprintf
          ppf
          "The seed for cycle %a has been cleared from the context  (oldest \
           known seed is for cycle %a)"
          Cycle_repr.pp
          cycle
          Cycle_repr.pp
          oldest
      else
        Format.fprintf
          ppf
          "The seed for cycle %a has not been computed yet  (latest known \
           seed is for cycle %a)"
          Cycle_repr.pp
          cycle
          Cycle_repr.pp
          latest)
    Data_encoding.(
      obj3
        (req "oldest" Cycle_repr.encoding)
        (req "requested" Cycle_repr.encoding)
        (req "latest" Cycle_repr.encoding))
    (function
      | Unknown {oldest; cycle; latest} ->
          Some (oldest, cycle, latest)
      | _ ->
          None)
    (fun (oldest, cycle, latest) -> Unknown {oldest; cycle; latest})

let compute_for_cycle c ~revealed cycle =
  match Cycle_repr.pred cycle with
  | None ->
      assert false (* should not happen *)
  | Some previous_cycle ->
      let levels = Level_storage.levels_with_commitments_in_cycle c revealed in
      let combine (c, random_seed, unrevealed) level =
        Storage.Seed.Nonce.get c level
        >>=? function
        | Revealed nonce ->
            Storage.Seed.Nonce.delete c level
            >>=? fun c ->
            return (c, Seed_repr.nonce random_seed nonce, unrevealed)
        | Unrevealed u ->
            Storage.Seed.Nonce.delete c level
            >>=? fun c -> return (c, random_seed, u :: unrevealed)
      in
      Storage.Seed.For_cycle.get c previous_cycle
      >>=? fun prev_seed ->
      let seed = Seed_repr.deterministic_seed prev_seed in
      fold_left_s combine (c, seed, []) levels
      >>=? fun (c, seed, unrevealed) ->
      Storage.Seed.For_cycle.init c cycle seed
      >>=? fun c -> return (c, unrevealed)

let for_cycle ctxt cycle =
  let preserved = Constants_storage.preserved_cycles ctxt in
  let current_level = Level_storage.current ctxt in
  let current_cycle = current_level.cycle in
  let latest =
    if Cycle_repr.(current_cycle = root) then
      Cycle_repr.add current_cycle (preserved + 1)
    else Cycle_repr.add current_cycle preserved
  in
  let oldest =
    match Cycle_repr.sub current_cycle preserved with
    | None ->
        Cycle_repr.root
    | Some oldest ->
        oldest
  in
  fail_unless
    Cycle_repr.(oldest <= cycle && cycle <= latest)
    (Unknown {oldest; cycle; latest})
  >>=? fun () -> Storage.Seed.For_cycle.get ctxt cycle

let clear_cycle c cycle = Storage.Seed.For_cycle.delete c cycle

let init ctxt =
  let preserved = Constants_storage.preserved_cycles ctxt in
  List.fold_left2
    (fun ctxt c seed ->
      ctxt
      >>=? fun ctxt ->
      let cycle = Cycle_repr.of_int32_exn (Int32.of_int c) in
      Storage.Seed.For_cycle.init ctxt cycle seed)
    (return ctxt)
    (0 --> (preserved + 1))
    (Seed_repr.initial_seeds (preserved + 2))

let cycle_end ctxt last_cycle =
  let preserved = Constants_storage.preserved_cycles ctxt in
  ( match Cycle_repr.sub last_cycle preserved with
  | None ->
      return ctxt
  | Some cleared_cycle ->
      clear_cycle ctxt cleared_cycle )
  >>=? fun ctxt ->
  match Cycle_repr.pred last_cycle with
  | None ->
      return (ctxt, [])
  | Some revealed ->
      (* cycle with revelations *)
      let inited_seed_cycle = Cycle_repr.add last_cycle (preserved + 1) in
      compute_for_cycle ctxt ~revealed inited_seed_cycle
seed_storage_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Misc.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  register_error_kind
    (* ❌ Variants not supported *)
    variant "seed.unknown_seed" % string "Unknown seed" % string
    "The requested seed is not available" % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let '(oldest, cycle, latest) := function_parameter in
          if op_lt cycle oldest then
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "The seed for cycle " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " has been cleared from the context  (oldest known seed is for cycle "
                        % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          ")" % char
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "The seed for cycle %a has been cleared from the context  (oldest known seed is for cycle %a)"
                  % string) Cycle_repr.pp cycle Cycle_repr.pp oldest
          else
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "The seed for cycle " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                      " has not been computed yet  (latest known seed is for cycle "
                        % string
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                          ")" % char
                          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
                "The seed for cycle %a has not been computed yet  (latest known seed is for cycle %a)"
                  % string) Cycle_repr.pp cycle Cycle_repr.pp latest))
    (obj3 (req None None "oldest" % string Cycle_repr.encoding)
      (req None None "requested" % string Cycle_repr.encoding)
      (req None None "latest" % string Cycle_repr.encoding))
    (fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_environment_alpha__Environment.Error_monad.Unknown {|
          oldest := oldest; cycle := cycle; latest := latest |} =>
        Some (oldest, cycle, latest)
      | _ => None
      end)
    (fun function_parameter =>
      let '(oldest, cycle, latest) := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Unknown
        {| oldest := oldest; cycle := cycle; latest := latest |}).

Definition compute_for_cycle
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  (revealed : Tezos_raw_protocol_alpha.Cycle_repr.t)
  (cycle : Tezos_raw_protocol_alpha.Cycle_repr.cycle)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.t *
        list Tezos_raw_protocol_alpha__Storage.Seed.unrevealed_nonce)) :=
  match Cycle_repr.pred cycle with
  | None =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  | Some previous_cycle =>
    let levels := Level_storage.levels_with_commitments_in_cycle c revealed in
    let combine
      (function_parameter :
      Tezos_raw_protocol_alpha.Storage.Seed.Nonce.context *
        Tezos_raw_protocol_alpha.Seed_repr.seed *
        list Tezos_raw_protocol_alpha__Storage.Seed.unrevealed_nonce)
      : Tezos_raw_protocol_alpha.Level_repr.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (Tezos_raw_protocol_alpha.Raw_context.t *
              Tezos_raw_protocol_alpha.Seed_repr.seed *
              list Tezos_raw_protocol_alpha__Storage.Seed.unrevealed_nonce)) :=
      let '(c, random_seed, unrevealed) := function_parameter in
      fun level =>
        op_gtgteqquestion (Storage.Seed.Nonce.get c level)
          (fun function_parameter =>
            match function_parameter with
            | Tezos_raw_protocol_alpha__Storage.Seed.Revealed nonce =>
              op_gtgteqquestion (Storage.Seed.Nonce.delete c level)
                (fun c =>
                  __return (c, (Seed_repr.nonce random_seed nonce), unrevealed))
            | Tezos_raw_protocol_alpha__Storage.Seed.Unrevealed u =>
              op_gtgteqquestion (Storage.Seed.Nonce.delete c level)
                (fun c => __return (c, random_seed, (cons u unrevealed)))
            end) in
    op_gtgteqquestion (Storage.Seed.For_cycle.get c previous_cycle)
      (fun prev_seed =>
        let seed := Seed_repr.deterministic_seed prev_seed in
        op_gtgteqquestion (fold_left_s combine (c, seed, []) levels)
          (fun function_parameter =>
            let '(c, seed, unrevealed) := function_parameter in
            op_gtgteqquestion (Storage.Seed.For_cycle.init c cycle seed)
              (fun c => __return (c, unrevealed))))
  end.

Definition for_cycle
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (cycle : Tezos_raw_protocol_alpha.Cycle_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Seed_repr.seed) :=
  let preserved := Constants_storage.preserved_cycles ctxt in
  let current_level := Level_storage.current ctxt in
  let current_cycle := cycle current_level in
  let latest :=
    if op_eq current_cycle root then
      Cycle_repr.add current_cycle (op_plus preserved 1)
    else
      Cycle_repr.add current_cycle preserved in
  let oldest :=
    match Cycle_repr.sub current_cycle preserved with
    | None => Cycle_repr.root
    | Some oldest => oldest
    end in
  op_gtgteqquestion
    (fail_unless (op_andand (op_lteq oldest cycle) (op_lteq cycle latest))
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Unknown
        {| oldest := oldest; cycle := cycle; latest := latest |}))
    (fun function_parameter =>
      let 'tt := function_parameter in
      Storage.Seed.For_cycle.get ctxt cycle).

Definition clear_cycle
  (c : Tezos_raw_protocol_alpha.Raw_context.t)
  (cycle : Tezos_raw_protocol_alpha.Cycle_repr.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  Storage.Seed.For_cycle.delete c cycle.

Definition init (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let preserved := Constants_storage.preserved_cycles ctxt in
  List.fold_left2
    (fun ctxt =>
      fun c =>
        fun seed =>
          op_gtgteqquestion ctxt
            (fun ctxt =>
              let cycle := Cycle_repr.of_int32_exn (Int32.of_int c) in
              Storage.Seed.For_cycle.init ctxt cycle seed)) (__return ctxt)
    (op_minusminusgt 0 (op_plus preserved 1))
    (Seed_repr.initial_seeds (op_plus preserved 2)).

Definition cycle_end
  (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  (last_cycle : Tezos_raw_protocol_alpha.Cycle_repr.cycle)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_raw_protocol_alpha.Raw_context.context *
        list Tezos_raw_protocol_alpha__Storage.Seed.unrevealed_nonce)) :=
  let preserved := Constants_storage.preserved_cycles ctxt in
  op_gtgteqquestion
    match Cycle_repr.sub last_cycle preserved with
    | None => __return ctxt
    | Some cleared_cycle => clear_cycle ctxt cleared_cycle
    end
    (fun ctxt =>
      match Cycle_repr.pred last_cycle with
      | None => __return (ctxt, [])
      | Some revealed =>
        let inited_seed_cycle := Cycle_repr.add last_cycle (op_plus preserved 1)
          in
        compute_for_cycle ctxt revealed inited_seed_cycle
      end).
seed_storage.mli 2 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type error +=
  | Unknown of {
      oldest : Cycle_repr.t;
      cycle : Cycle_repr.t;
      latest : Cycle_repr.t;
    }

(* `Permanent *)

(** Generates the first [preserved_cycles+2] seeds for which
    there are no nonces. *)
val init : Raw_context.t -> Raw_context.t tzresult Lwt.t

val for_cycle : Raw_context.t -> Cycle_repr.t -> Seed_repr.seed tzresult Lwt.t

(** If it is the end of the cycle, computes and stores the seed of cycle at
    distance [preserved_cycle+2] in the future using the seed of the previous
    cycle and the revelations of the current one.  *)
val cycle_end :
  Raw_context.t ->
  Cycle_repr.t ->
  (Raw_context.t * Nonce_storage.unrevealed list) tzresult Lwt.t
seed_storage_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

extensible_type

Parameter init :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter for_cycle :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Seed_repr.seed).

Parameter cycle_end :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Cycle_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (Tezos_raw_protocol_alpha.Raw_context.t *
          list Tezos_raw_protocol_alpha.Nonce_storage.unrevealed)).
services_registration.ml 12 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

type rpc_context = {
  block_hash : Block_hash.t;
  block_header : Block_header.shell_header;
  context : Alpha_context.t;
}

let rpc_init ({block_hash; block_header; context} : Updater.rpc_context) =
  let level = block_header.level in
  let timestamp = block_header.timestamp in
  let fitness = block_header.fitness in
  Alpha_context.prepare
    ~level
    ~predecessor_timestamp:timestamp
    ~timestamp
    ~fitness
    context
  >>=? fun context -> return {block_hash; block_header; context}

let rpc_services =
  ref (RPC_directory.empty : Updater.rpc_context RPC_directory.t)

let register0_fullctxt s f =
  rpc_services :=
    RPC_directory.register !rpc_services s (fun ctxt q i ->
        rpc_init ctxt >>=? fun ctxt -> f ctxt q i)

let opt_register0_fullctxt s f =
  rpc_services :=
    RPC_directory.opt_register !rpc_services s (fun ctxt q i ->
        rpc_init ctxt >>=? fun ctxt -> f ctxt q i)

let register0 s f = register0_fullctxt s (fun {context; _} -> f context)

let register0_noctxt s f =
  rpc_services := RPC_directory.register !rpc_services s (fun _ q i -> f q i)

let register1_fullctxt s f =
  rpc_services :=
    RPC_directory.register !rpc_services s (fun (ctxt, arg) q i ->
        rpc_init ctxt >>=? fun ctxt -> f ctxt arg q i)

let register1 s f = register1_fullctxt s (fun {context; _} x -> f context x)

let register1_noctxt s f =
  rpc_services :=
    RPC_directory.register !rpc_services s (fun (_, arg) q i -> f arg q i)

let register2_fullctxt s f =
  rpc_services :=
    RPC_directory.register !rpc_services s (fun ((ctxt, arg1), arg2) q i ->
        rpc_init ctxt >>=? fun ctxt -> f ctxt arg1 arg2 q i)

let register2 s f =
  register2_fullctxt s (fun {context; _} a1 a2 q i -> f context a1 a2 q i)

let get_rpc_services () =
  let p =
    RPC_directory.map
      (fun c ->
        rpc_init c
        >>= function Error _ -> assert false | Ok c -> Lwt.return c.context)
      (Storage_description.build_directory Alpha_context.description)
  in
  RPC_directory.register_dynamic_directory
    !rpc_services
    RPC_path.(open_root / "context" / "raw" / "json")
    (fun _ -> Lwt.return p)
services_registration_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Record rpc_context := {
  block_hash :
    Tezos_protocol_environment_alpha__Environment.Block_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t);
  block_header :
    Tezos_raw_protocol_alpha.Alpha_context.Block_header.shell_header;
  context : Tezos_raw_protocol_alpha.Alpha_context.t }.

Definition rpc_init
  (function_parameter :
    Tezos_protocol_environment_alpha__Environment.Updater.rpc_context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      rpc_context) :=
  let '{|
    block_hash := block_hash;
      block_header := block_header;
      context := context
      |} := function_parameter in
  let level := level block_header in
  let timestamp := timestamp block_header in
  let fitness := fitness block_header in
  op_gtgteqquestion
    (Alpha_context.prepare context level timestamp timestamp fitness)
    (fun context =>
      __return
        {| block_hash := block_hash; block_header := block_header;
          context := context |}).

Definition rpc_services
  : Tezos_protocol_environment_alpha__Environment.Pervasives.ref
    (Tezos_protocol_environment_alpha__Environment.RPC_directory.t
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context) :=
  ref RPC_directory.empty.

Definition register0_fullctxt {A B C : Type}
  (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context A B C)
  (f :
    rpc_context ->
      A ->
        B ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              C)) : unit :=
  op_coloneq rpc_services
    (RPC_directory.register (op_exclamation rpc_services) s
      (fun ctxt =>
        fun q =>
          fun i => op_gtgteqquestion (rpc_init ctxt) (fun ctxt => f ctxt q i))).

Definition opt_register0_fullctxt {A B C : Type}
  (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context A B C)
  (f :
    rpc_context ->
      A ->
        B ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (option C))) : unit :=
  op_coloneq rpc_services
    (RPC_directory.opt_register (op_exclamation rpc_services) s
      (fun ctxt =>
        fun q =>
          fun i => op_gtgteqquestion (rpc_init ctxt) (fun ctxt => f ctxt q i))).

Definition register0 {A B C : Type}
  (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context A B C)
  (f :
    Tezos_raw_protocol_alpha.Alpha_context.t ->
      A ->
        B ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              C)) : unit :=
  register0_fullctxt s
    (fun function_parameter =>
      let '{| context := context |} := function_parameter in
      f context).

Definition register0_noctxt {A B C D : Type}
  (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context A B C D)
  (f :
    B ->
      C ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult D))
  : unit :=
  op_coloneq rpc_services
    (RPC_directory.register (op_exclamation rpc_services) s
      (fun function_parameter =>
        let '_ := function_parameter in
        fun q => fun i => f q i)).

Definition register1_fullctxt {A B C D : Type}
  (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context * A) B
      C D)
  (f :
    rpc_context ->
      A ->
        B ->
          C ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                D)) : unit :=
  op_coloneq rpc_services
    (RPC_directory.register (op_exclamation rpc_services) s
      (fun function_parameter =>
        let '(ctxt, arg) := function_parameter in
        fun q =>
          fun i =>
            op_gtgteqquestion (rpc_init ctxt) (fun ctxt => f ctxt arg q i))).

Definition register1 {A B C D : Type}
  (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      (Tezos_protocol_environment_alpha__Environment.Updater.rpc_context * A) B
      C D)
  (f :
    Tezos_raw_protocol_alpha.Alpha_context.t ->
      A ->
        B ->
          C ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                D)) : unit :=
  register1_fullctxt s
    (fun function_parameter =>
      let '{| context := context |} := function_parameter in
      fun x => f context x).

Definition register1_noctxt {A B C D E : Type}
  (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context (A * B)
      C D E)
  (f :
    B ->
      C ->
        D ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              E)) : unit :=
  op_coloneq rpc_services
    (RPC_directory.register (op_exclamation rpc_services) s
      (fun function_parameter =>
        let '(_, arg) := function_parameter in
        fun q => fun i => f arg q i)).

Definition register2_fullctxt {A B C D E : Type}
  (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      ((Tezos_protocol_environment_alpha__Environment.Updater.rpc_context * A) *
        B) C D E)
  (f :
    rpc_context ->
      A ->
        B ->
          C ->
            D ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                  E)) : unit :=
  op_coloneq rpc_services
    (RPC_directory.register (op_exclamation rpc_services) s
      (fun function_parameter =>
        let '((ctxt, arg1), arg2) := function_parameter in
        fun q =>
          fun i =>
            op_gtgteqquestion (rpc_init ctxt) (fun ctxt => f ctxt arg1 arg2 q i))).

Definition register2 {A B C D E : Type}
  (s :
    Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      ((Tezos_protocol_environment_alpha__Environment.Updater.rpc_context * A) *
        B) C D E)
  (f :
    Tezos_raw_protocol_alpha.Alpha_context.t ->
      A ->
        B ->
          C ->
            D ->
              Tezos_protocol_environment_alpha__Environment.Lwt.t
                (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                  E)) : unit :=
  register2_fullctxt s
    (fun function_parameter =>
      let '{| context := context |} := function_parameter in
      fun a1 => fun a2 => fun q => fun i => f context a1 a2 q i).

Definition get_rpc_services (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.RPC_directory.directory
    Tezos_protocol_environment_alpha__Environment.Updater.rpc_context :=
  let 'tt := function_parameter in
  let p :=
    RPC_directory.map
      (fun c =>
        op_gtgteq (rpc_init c)
          (fun function_parameter =>
            match function_parameter with
            | Tezos_protocol_environment_alpha__Environment.Pervasives.Error _
              =>
              (* ❌ Assert instruction is not handled. *)
              assert false
            | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok c =>
              Lwt.__return (context c)
            end))
      (Storage_description.build_directory Alpha_context.description) in
  RPC_directory.register_dynamic_directory None (op_exclamation rpc_services)
    (op_div (op_div (op_div open_root "context" % string) "raw" % string)
      "json" % string)
    (fun function_parameter =>
      let '_ := function_parameter in
      Lwt.__return p).
storage.ml 93 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Storage_functors

module Int = struct
  type t = int

  let encoding = Data_encoding.uint16
end

module Int32 = struct
  type t = Int32.t

  let encoding = Data_encoding.int32
end

module Z = struct
  include Z

  let encoding = Data_encoding.z
end

module Int_index = struct
  type t = int

  let path_length = 1

  let to_path c l = string_of_int c :: l

  let of_path = function
    | [] | _ :: _ :: _ ->
        None
    | [c] ->
        int_of_string_opt c

  type 'a ipath = 'a * t

  let args =
    Storage_description.One
      {
        rpc_arg = RPC_arg.int;
        encoding = Data_encoding.int31;
        compare = Compare.Int.compare;
      }
end

module Make_index (H : Storage_description.INDEX) :
  INDEX with type t = H.t and type 'a ipath = 'a * H.t = struct
  include H

  type 'a ipath = 'a * t

  let args = Storage_description.One {rpc_arg; encoding; compare}
end

module Block_priority =
  Make_single_data_storage (Registered) (Raw_context)
    (struct
      let name = ["block_priority"]
    end)
    (Int)

(** Contracts handling *)

module Contract = struct
  module Raw_context =
    Make_subcontext (Registered) (Raw_context)
      (struct
        let name = ["contracts"]
      end)

  module Global_counter =
    Make_single_data_storage (Registered) (Raw_context)
      (struct
        let name = ["global_counter"]
      end)
      (Z)

  module Indexed_context =
    Make_indexed_subcontext
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["index"]
         end))
         (Make_index (Contract_repr.Index))

  let fold = Indexed_context.fold_keys

  let list = Indexed_context.keys

  module Balance =
    Indexed_context.Make_map
      (struct
        let name = ["balance"]
      end)
      (Tez_repr)

  module Frozen_balance_index =
    Make_indexed_subcontext
      (Make_subcontext (Registered) (Indexed_context.Raw_context)
         (struct
           let name = ["frozen_balance"]
         end))
         (Make_index (Cycle_repr.Index))

  module Frozen_deposits =
    Frozen_balance_index.Make_map
      (struct
        let name = ["deposits"]
      end)
      (Tez_repr)

  module Frozen_fees =
    Frozen_balance_index.Make_map
      (struct
        let name = ["fees"]
      end)
      (Tez_repr)

  module Frozen_rewards =
    Frozen_balance_index.Make_map
      (struct
        let name = ["rewards"]
      end)
      (Tez_repr)

  module Manager =
    Indexed_context.Make_map
      (struct
        let name = ["manager"]
      end)
      (Manager_repr)

  module Delegate =
    Indexed_context.Make_map
      (struct
        let name = ["delegate"]
      end)
      (Signature.Public_key_hash)

  module Inactive_delegate =
    Indexed_context.Make_set
      (Registered)
      (struct
        let name = ["inactive_delegate"]
      end)

  module Delegate_desactivation =
    Indexed_context.Make_map
      (struct
        let name = ["delegate_desactivation"]
      end)
      (Cycle_repr)

  module Delegated =
    Make_data_set_storage
      (Make_subcontext (Registered) (Indexed_context.Raw_context)
         (struct
           let name = ["delegated"]
         end))
         (Make_index (Contract_repr.Index))

  module Counter =
    Indexed_context.Make_map
      (struct
        let name = ["counter"]
      end)
      (Z)

  (* Consume gas for serilization and deserialization of expr in this
     module *)
  module Make_carbonated_map_expr (N : Storage_sigs.NAME) = struct
    module I =
      Indexed_context.Make_carbonated_map
        (N)
        (struct
          type t = Script_repr.lazy_expr

          let encoding = Script_repr.lazy_expr_encoding
        end)

    type context = I.context

    type key = I.key

    type value = I.value

    let mem = I.mem

    let delete = I.delete

    let remove = I.remove

    let consume_deserialize_gas ctxt value =
      Lwt.return
      @@ ( Raw_context.check_enough_gas
             ctxt
             (Script_repr.minimal_deserialize_cost value)
         >>? fun () ->
         Script_repr.force_decode value
         >>? fun (_value, value_cost) ->
         Raw_context.consume_gas ctxt value_cost )

    let consume_serialize_gas ctxt value =
      Lwt.return
      @@ ( Script_repr.force_bytes value
         >>? fun (_value, value_cost) ->
         Raw_context.consume_gas ctxt value_cost )

    let get ctxt contract =
      I.get ctxt contract
      >>=? fun (ctxt, value) ->
      consume_deserialize_gas ctxt value >>|? fun ctxt -> (ctxt, value)

    let get_option ctxt contract =
      I.get_option ctxt contract
      >>=? fun (ctxt, value_opt) ->
      match value_opt with
      | None ->
          return (ctxt, None)
      | Some value ->
          consume_deserialize_gas ctxt value >>|? fun ctxt -> (ctxt, value_opt)

    let set ctxt contract value =
      consume_serialize_gas ctxt value
      >>=? fun ctxt -> I.set ctxt contract value

    let set_option ctxt contract value_opt =
      match value_opt with
      | None ->
          I.set_option ctxt contract None
      | Some value ->
          consume_serialize_gas ctxt value
          >>=? fun ctxt -> I.set_option ctxt contract value_opt

    let init ctxt contract value =
      consume_serialize_gas ctxt value
      >>=? fun ctxt -> I.init ctxt contract value

    let init_set ctxt contract value =
      consume_serialize_gas ctxt value
      >>=? fun ctxt -> I.init_set ctxt contract value
  end

  module Code = Make_carbonated_map_expr (struct
    let name = ["code"]
  end)

  module Storage = Make_carbonated_map_expr (struct
    let name = ["storage"]
  end)

  module Paid_storage_space =
    Indexed_context.Make_map
      (struct
        let name = ["paid_bytes"]
      end)
      (Z)

  module Used_storage_space =
    Indexed_context.Make_map
      (struct
        let name = ["used_bytes"]
      end)
      (Z)

  module Roll_list =
    Indexed_context.Make_map
      (struct
        let name = ["roll_list"]
      end)
      (Roll_repr)

  module Change =
    Indexed_context.Make_map
      (struct
        let name = ["change"]
      end)
      (Tez_repr)
end

(** Big maps handling *)

module Big_map = struct
  module Raw_context =
    Make_subcontext (Registered) (Raw_context)
      (struct
        let name = ["big_maps"]
      end)

  module Next = struct
    include Make_single_data_storage (Registered) (Raw_context)
              (struct
                let name = ["next"]
              end)
              (Z)

    let incr ctxt =
      get ctxt
      >>=? fun i -> set ctxt (Z.succ i) >>=? fun ctxt -> return (ctxt, i)

    let init ctxt = init ctxt Z.zero
  end

  module Index = struct
    type t = Z.t

    let rpc_arg =
      let construct = Z.to_string in
      let destruct hash =
        match Z.of_string hash with
        | exception _ ->
            Error "Cannot parse big map id"
        | id ->
            Ok id
      in
      RPC_arg.make
        ~descr:"A big map identifier"
        ~name:"big_map_id"
        ~construct
        ~destruct
        ()

    let encoding =
      Data_encoding.def
        "big_map_id"
        ~title:"Big map identifier"
        ~description:"A big map identifier"
        Z.encoding

    let compare = Compare.Z.compare

    let path_length = 7

    let to_path c l =
      let raw_key = Data_encoding.Binary.to_bytes_exn encoding c in
      let (`Hex index_key) = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
      String.sub index_key 0 2 :: String.sub index_key 2 2
      :: String.sub index_key 4 2 :: String.sub index_key 6 2
      :: String.sub index_key 8 2 :: String.sub index_key 10 2 :: Z.to_string c
      :: l

    let of_path = function
      | []
      | [_]
      | [_; _]
      | [_; _; _]
      | [_; _; _; _]
      | [_; _; _; _; _]
      | [_; _; _; _; _; _]
      | _ :: _ :: _ :: _ :: _ :: _ :: _ :: _ :: _ ->
          None
      | [index1; index2; index3; index4; index5; index6; key] ->
          let c = Z.of_string key in
          let raw_key = Data_encoding.Binary.to_bytes_exn encoding c in
          let (`Hex index_key) = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
          assert (Compare.String.(String.sub index_key 0 2 = index1)) ;
          assert (Compare.String.(String.sub index_key 2 2 = index2)) ;
          assert (Compare.String.(String.sub index_key 4 2 = index3)) ;
          assert (Compare.String.(String.sub index_key 6 2 = index4)) ;
          assert (Compare.String.(String.sub index_key 8 2 = index5)) ;
          assert (Compare.String.(String.sub index_key 10 2 = index6)) ;
          Some c
  end

  module Indexed_context =
    Make_indexed_subcontext
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["index"]
         end))
         (Make_index (Index))

  let rpc_arg = Index.rpc_arg

  let fold = Indexed_context.fold_keys

  let list = Indexed_context.keys

  let remove_rec ctxt n = Indexed_context.remove_rec ctxt n

  let copy ctxt ~from ~to_ = Indexed_context.copy ctxt ~from ~to_

  type key = Raw_context.t * Z.t

  module Total_bytes =
    Indexed_context.Make_map
      (struct
        let name = ["total_bytes"]
      end)
      (Z)

  module Key_type =
    Indexed_context.Make_map
      (struct
        let name = ["key_type"]
      end)
      (struct
        type t = Script_repr.expr

        let encoding = Script_repr.expr_encoding
      end)

  module Value_type =
    Indexed_context.Make_map
      (struct
        let name = ["value_type"]
      end)
      (struct
        type t = Script_repr.expr

        let encoding = Script_repr.expr_encoding
      end)

  module Contents = struct
    module I =
      Storage_functors.Make_indexed_carbonated_data_storage
        (Make_subcontext (Registered) (Indexed_context.Raw_context)
           (struct
             let name = ["contents"]
           end))
           (Make_index (Script_expr_hash))
           (struct
             type t = Script_repr.expr

             let encoding = Script_repr.expr_encoding
           end)

    type context = I.context

    type key = I.key

    type value = I.value

    let mem = I.mem

    let delete = I.delete

    let remove = I.remove

    let set = I.set

    let set_option = I.set_option

    let init = I.init

    let init_set = I.init_set

    let consume_deserialize_gas ctxt value =
      Lwt.return
      @@ Raw_context.consume_gas ctxt (Script_repr.deserialized_cost value)

    let get ctxt contract =
      I.get ctxt contract
      >>=? fun (ctxt, value) ->
      consume_deserialize_gas ctxt value >>|? fun ctxt -> (ctxt, value)

    let get_option ctxt contract =
      I.get_option ctxt contract
      >>=? fun (ctxt, value_opt) ->
      match value_opt with
      | None ->
          return (ctxt, None)
      | Some value ->
          consume_deserialize_gas ctxt value >>|? fun ctxt -> (ctxt, value_opt)
  end
end

module Delegates =
  Make_data_set_storage
    (Make_subcontext (Registered) (Raw_context)
       (struct
         let name = ["delegates"]
       end))
       (Make_index (Signature.Public_key_hash))

module Active_delegates_with_rolls =
  Make_data_set_storage
    (Make_subcontext (Registered) (Raw_context)
       (struct
         let name = ["active_delegates_with_rolls"]
       end))
       (Make_index (Signature.Public_key_hash))

module Delegates_with_frozen_balance_index =
  Make_indexed_subcontext
    (Make_subcontext (Registered) (Raw_context)
       (struct
         let name = ["delegates_with_frozen_balance"]
       end))
       (Make_index (Cycle_repr.Index))

module Delegates_with_frozen_balance =
  Make_data_set_storage
    (Delegates_with_frozen_balance_index.Raw_context)
    (Make_index (Signature.Public_key_hash))

(** Rolls *)

module Cycle = struct
  module Indexed_context =
    Make_indexed_subcontext
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["cycle"]
         end))
         (Make_index (Cycle_repr.Index))

  module Last_roll =
    Make_indexed_data_storage
      (Make_subcontext (Registered) (Indexed_context.Raw_context)
         (struct
           let name = ["last_roll"]
         end))
         (Int_index)
      (Roll_repr)

  module Roll_snapshot =
    Indexed_context.Make_map
      (struct
        let name = ["roll_snapshot"]
      end)
      (Int)

  type unrevealed_nonce = {
    nonce_hash : Nonce_hash.t;
    delegate : Signature.Public_key_hash.t;
    rewards : Tez_repr.t;
    fees : Tez_repr.t;
  }

  type nonce_status =
    | Unrevealed of unrevealed_nonce
    | Revealed of Seed_repr.nonce

  let nonce_status_encoding =
    let open Data_encoding in
    union
      [ case
          (Tag 0)
          ~title:"Unrevealed"
          (tup4
             Nonce_hash.encoding
             Signature.Public_key_hash.encoding
             Tez_repr.encoding
             Tez_repr.encoding)
          (function
            | Unrevealed {nonce_hash; delegate; rewards; fees} ->
                Some (nonce_hash, delegate, rewards, fees)
            | _ ->
                None)
          (fun (nonce_hash, delegate, rewards, fees) ->
            Unrevealed {nonce_hash; delegate; rewards; fees});
        case
          (Tag 1)
          ~title:"Revealed"
          Seed_repr.nonce_encoding
          (function Revealed nonce -> Some nonce | _ -> None)
          (fun nonce -> Revealed nonce) ]

  module Nonce =
    Make_indexed_data_storage
      (Make_subcontext (Registered) (Indexed_context.Raw_context)
         (struct
           let name = ["nonces"]
         end))
         (Make_index (Raw_level_repr.Index))
         (struct
           type t = nonce_status

           let encoding = nonce_status_encoding
         end)

  module Seed =
    Indexed_context.Make_map
      (struct
        let name = ["random_seed"]
      end)
      (struct
        type t = Seed_repr.seed

        let encoding = Seed_repr.seed_encoding
      end)
end

module Roll = struct
  module Raw_context =
    Make_subcontext (Registered) (Raw_context)
      (struct
        let name = ["rolls"]
      end)

  module Indexed_context =
    Make_indexed_subcontext
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["index"]
         end))
         (Make_index (Roll_repr.Index))

  module Next =
    Make_single_data_storage (Registered) (Raw_context)
      (struct
        let name = ["next"]
      end)
      (Roll_repr)

  module Limbo =
    Make_single_data_storage (Registered) (Raw_context)
      (struct
        let name = ["limbo"]
      end)
      (Roll_repr)

  module Delegate_roll_list =
    Wrap_indexed_data_storage
      (Contract.Roll_list)
      (struct
        type t = Signature.Public_key_hash.t

        let wrap = Contract_repr.implicit_contract

        let unwrap = Contract_repr.is_implicit
      end)

  module Successor =
    Indexed_context.Make_map
      (struct
        let name = ["successor"]
      end)
      (Roll_repr)

  module Delegate_change =
    Wrap_indexed_data_storage
      (Contract.Change)
      (struct
        type t = Signature.Public_key_hash.t

        let wrap = Contract_repr.implicit_contract

        let unwrap = Contract_repr.is_implicit
      end)

  module Snapshoted_owner_index = struct
    type t = Cycle_repr.t * int

    let path_length = Cycle_repr.Index.path_length + 1

    let to_path (c, n) s = Cycle_repr.Index.to_path c (string_of_int n :: s)

    let of_path l =
      match Misc.take Cycle_repr.Index.path_length l with
      | None | Some (_, ([] | _ :: _ :: _)) ->
          None
      | Some (l1, [l2]) -> (
        match (Cycle_repr.Index.of_path l1, int_of_string_opt l2) with
        | (None, _) | (_, None) ->
            None
        | (Some c, Some i) ->
            Some (c, i) )

    type 'a ipath = ('a * Cycle_repr.t) * int

    let left_args =
      Storage_description.One
        {
          rpc_arg = Cycle_repr.rpc_arg;
          encoding = Cycle_repr.encoding;
          compare = Cycle_repr.compare;
        }

    let right_args =
      Storage_description.One
        {
          rpc_arg = RPC_arg.int;
          encoding = Data_encoding.int31;
          compare = Compare.Int.compare;
        }

    let args = Storage_description.(Pair (left_args, right_args))
  end

  module Owner =
    Make_indexed_data_snapshotable_storage
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["owner"]
         end))
         (Snapshoted_owner_index)
      (Make_index (Roll_repr.Index))
      (Signature.Public_key)

  module Snapshot_for_cycle = Cycle.Roll_snapshot
  module Last_for_snapshot = Cycle.Last_roll

  let clear = Indexed_context.clear
end

(** Votes *)

module Vote = struct
  module Raw_context =
    Make_subcontext (Registered) (Raw_context)
      (struct
        let name = ["votes"]
      end)

  module Current_period_kind =
    Make_single_data_storage (Registered) (Raw_context)
      (struct
        let name = ["current_period_kind"]
      end)
      (struct
        type t = Voting_period_repr.kind

        let encoding = Voting_period_repr.kind_encoding
      end)

  module Participation_ema =
    Make_single_data_storage (Registered) (Raw_context)
      (struct
        let name = ["participation_ema"]
      end)
      (Int32)

  module Current_proposal =
    Make_single_data_storage (Registered) (Raw_context)
      (struct
        let name = ["current_proposal"]
      end)
      (Protocol_hash)

  module Listings_size =
    Make_single_data_storage (Registered) (Raw_context)
      (struct
        let name = ["listings_size"]
      end)
      (Int32)

  module Listings =
    Make_indexed_data_storage
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["listings"]
         end))
         (Make_index (Signature.Public_key_hash))
         (Int32)

  module Proposals =
    Make_data_set_storage
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["proposals"]
         end))
         (Pair
            (Make_index
               (Protocol_hash))
               (Make_index (Signature.Public_key_hash)))

  module Proposals_count =
    Make_indexed_data_storage
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["proposals_count"]
         end))
         (Make_index (Signature.Public_key_hash))
         (Int)

  module Ballots =
    Make_indexed_data_storage
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["ballots"]
         end))
         (Make_index (Signature.Public_key_hash))
         (struct
           type t = Vote_repr.ballot

           let encoding = Vote_repr.ballot_encoding
         end)
end

(** Seed *)

module Seed = struct
  type unrevealed_nonce = Cycle.unrevealed_nonce = {
    nonce_hash : Nonce_hash.t;
    delegate : Signature.Public_key_hash.t;
    rewards : Tez_repr.t;
    fees : Tez_repr.t;
  }

  type nonce_status = Cycle.nonce_status =
    | Unrevealed of unrevealed_nonce
    | Revealed of Seed_repr.nonce

  module Nonce = struct
    open Level_repr

    type context = Raw_context.t

    let mem ctxt l = Cycle.Nonce.mem (ctxt, l.cycle) l.level

    let get ctxt l = Cycle.Nonce.get (ctxt, l.cycle) l.level

    let get_option ctxt l = Cycle.Nonce.get_option (ctxt, l.cycle) l.level

    let set ctxt l v = Cycle.Nonce.set (ctxt, l.cycle) l.level v

    let init ctxt l v = Cycle.Nonce.init (ctxt, l.cycle) l.level v

    let init_set ctxt l v = Cycle.Nonce.init_set (ctxt, l.cycle) l.level v

    let set_option ctxt l v = Cycle.Nonce.set_option (ctxt, l.cycle) l.level v

    let delete ctxt l = Cycle.Nonce.delete (ctxt, l.cycle) l.level

    let remove ctxt l = Cycle.Nonce.remove (ctxt, l.cycle) l.level
  end

  module For_cycle = Cycle.Seed
end

(** Commitments *)

module Commitments =
  Make_indexed_data_storage
    (Make_subcontext (Registered) (Raw_context)
       (struct
         let name = ["commitments"]
       end))
       (Make_index (Blinded_public_key_hash.Index))
       (Tez_repr)

(** Ramp up security deposits... *)

module Ramp_up = struct
  module Rewards =
    Make_indexed_data_storage
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["ramp_up"; "rewards"]
         end))
         (Make_index (Cycle_repr.Index))
         (struct
           type t = Tez_repr.t * Tez_repr.t

           let encoding =
             Data_encoding.tup2 Tez_repr.encoding Tez_repr.encoding
         end)

  module Security_deposits =
    Make_indexed_data_storage
      (Make_subcontext (Registered) (Raw_context)
         (struct
           let name = ["ramp_up"; "deposits"]
         end))
         (Make_index (Cycle_repr.Index))
         (struct
           type t = Tez_repr.t * Tez_repr.t

           let encoding =
             Data_encoding.tup2 Tez_repr.encoding Tez_repr.encoding
         end)
end
storage_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Storage_functors.

Module Int.
  Definition t := Z.
  
  Definition encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding Z :=
    Data_encoding.uint16.
End Int.

Module Int32.
  Definition t := Tezos_protocol_environment_alpha__Environment.Int32.t.
  
  Definition encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding int32 :=
    Data_encoding.int32.
End Int32.

Module Z.
  Export Z.
  
  Definition encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      Tezos_protocol_environment_alpha__Environment.Z.t := Data_encoding.z.
End Z.

Module Int_index.
  Definition t := Z.
  
  Definition path_length : Z := 1.
  
  Definition to_path (c : Z) (l : list string) : list string :=
    cons (string_of_int c) l.
  
  Definition of_path (function_parameter : list string) : option Z :=
    match function_parameter with
    | [] | cons _ (cons _ _) => None
    | cons c [] => int_of_string_opt c
    end.
  
  Definition ipath (a : Type) := a * t.
  
  Definition args {A : Type}
    : Tezos_raw_protocol_alpha.Storage_description.args A
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t)
      (A *
        Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t)) :=
    Tezos_raw_protocol_alpha.Storage_description.One
      {| rpc_arg := RPC_arg.int; encoding := Data_encoding.int31;
        compare :=
          Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.compare)
        |}.
End Int_index.

(* ❌ Functors are not handled. *)
functor

(* ❌ Applications of functors are not handled. *)
functor_application

Module Contract.
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  Definition fold {A : Type}
    : Indexed_context.context ->
      A ->
        (Indexed_context.key ->
          A -> Tezos_protocol_environment_alpha__Environment.Lwt.t A) ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t A :=
    Indexed_context.fold_keys.
  
  Definition list
    : Indexed_context.context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (list Indexed_context.key) := Indexed_context.keys.
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Functors are not handled. *)
  functor
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
End Contract.

Module Big_map.
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  Module Next.
    (* ❌ Cannot include this kind of module expression *)
    include
    
    Definition incr (ctxt : context)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * value)) :=
      op_gtgteqquestion (get ctxt)
        (fun i =>
          op_gtgteqquestion (set ctxt (Z.succ i))
            (fun ctxt => __return (ctxt, i))).
    
    Definition init (ctxt : context)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t) := init ctxt Z.zero.
  End Next.
  
  Module Index.
    Definition t := Z.t.
    
    Definition rpc_arg
      : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg Z.t :=
      let construct := Z.to_string in
      let destruct (hash : string)
        : Tezos_protocol_environment_alpha__Environment.Pervasives.result Z.t
          string :=
        let 'id := Z.of_string hash in
        Tezos_protocol_environment_alpha__Environment.Pervasives.Ok id in
      RPC_arg.make (Some "A big map identifier" % string) "big_map_id" % string
        destruct construct tt.
    
    Definition encoding
      : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
        Tezos_protocol_environment_alpha__Environment.Z.t :=
      Data_encoding.def "big_map_id" % string
        (Some "Big map identifier" % string)
        (Some "A big map identifier" % string) Z.encoding.
    
    Definition compare
      : Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.t)
        ->
        Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.t)
          -> Z :=
      Tezos_protocol_environment_alpha__Environment.Compare.Z.(Tezos_protocol_environment_alpha__Environment.S.Compare.compare).
    
    Definition path_length : Z := 7.
    
    Definition to_path
      (c : Tezos_protocol_environment_alpha__Environment.Z.t) (l : list string)
      : list string :=
      let raw_key := Data_encoding.Binary.to_bytes_exn encoding c in
      let 'Hex index_key := MBytes.to_hex (Raw_hashes.blake2b raw_key) in
      cons (String.sub index_key 0 2)
        (cons (String.sub index_key 2 2)
          (cons (String.sub index_key 4 2)
            (cons (String.sub index_key 6 2)
              (cons (String.sub index_key 8 2)
                (cons (String.sub index_key 10 2) (cons (Z.to_string c) l)))))).
    
    Definition of_path
      (function_parameter :
        list
          Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
      : option Z.t :=
      match function_parameter with
      |
        [] | cons _ [] | cons _ (cons _ []) | cons _ (cons _ (cons _ [])) |
          cons _ (cons _ (cons _ (cons _ []))) |
          cons _ (cons _ (cons _ (cons _ (cons _ [])))) |
          cons _ (cons _ (cons _ (cons _ (cons _ (cons _ []))))) |
          cons _
            (cons _ (cons _ (cons _ (cons _ (cons _ (cons _ (cons _ _))))))) =>
        None
      |
        cons index1
          (cons index2
            (cons index3 (cons index4 (cons index5 (cons index6 (cons key []))))))
        =>
        let c := Z.of_string key in
        let raw_key := Data_encoding.Binary.to_bytes_exn encoding c in
        let 'Hex index_key := MBytes.to_hex (Raw_hashes.blake2b raw_key) in
        (* ❌ Sequences of instructions are not handled (operator ";") *)
        let _ :=
          (* ❌ Assert instruction is not handled. *)
          assert
            (Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
              (String.sub index_key 0 2) index1) in
        (* ❌ Sequences of instructions are not handled (operator ";") *)
        let _ :=
          (* ❌ Assert instruction is not handled. *)
          assert
            (Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
              (String.sub index_key 2 2) index2) in
        (* ❌ Sequences of instructions are not handled (operator ";") *)
        let _ :=
          (* ❌ Assert instruction is not handled. *)
          assert
            (Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
              (String.sub index_key 4 2) index3) in
        (* ❌ Sequences of instructions are not handled (operator ";") *)
        let _ :=
          (* ❌ Assert instruction is not handled. *)
          assert
            (Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
              (String.sub index_key 6 2) index4) in
        (* ❌ Sequences of instructions are not handled (operator ";") *)
        let _ :=
          (* ❌ Assert instruction is not handled. *)
          assert
            (Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
              (String.sub index_key 8 2) index5) in
        (* ❌ Sequences of instructions are not handled (operator ";") *)
        let _ :=
          (* ❌ Assert instruction is not handled. *)
          assert
            (Tezos_protocol_environment_alpha__Environment.Compare.String.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
              (String.sub index_key 10 2) index6) in
        Some c
      end.
  End Index.
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  Definition rpc_arg
    : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg Z.t :=
    Index.rpc_arg.
  
  Definition fold {A : Type}
    : Indexed_context.context ->
      A ->
        (Indexed_context.key ->
          A -> Tezos_protocol_environment_alpha__Environment.Lwt.t A) ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t A :=
    Indexed_context.fold_keys.
  
  Definition list
    : Indexed_context.context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (list Indexed_context.key) := Indexed_context.keys.
  
  Definition remove_rec
    (ctxt : Indexed_context.context) (n : Indexed_context.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      Indexed_context.context := Indexed_context.remove_rec ctxt n.
  
  Definition copy
    (ctxt : Indexed_context.context) (from : Indexed_context.key)
    (to_ : Indexed_context.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Indexed_context.context) := Indexed_context.copy ctxt from to_.
  
  Definition key := Raw_context.t * Z.t.
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  Module Contents.
    (* ❌ Applications of functors are not handled. *)
    functor_application
    
    Definition context := I.context.
    
    Definition key := I.key.
    
    Definition value := I.value.
    
    Definition mem
      : I.context ->
        I.key ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (Tezos_raw_protocol_alpha.Raw_context.t * bool)) := I.mem.
    
    Definition delete
      : I.context ->
        I.key ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (Tezos_raw_protocol_alpha.Raw_context.t * Z)) := I.delete.
    
    Definition remove
      : I.context ->
        I.key ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool)) := I.remove.
    
    Definition set
      : I.context ->
        I.key ->
          I.value ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                (Tezos_raw_protocol_alpha.Raw_context.t * Z)) := I.set.
    
    Definition set_option
      : I.context ->
        I.key ->
          option I.value ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool)) :=
      I.set_option.
    
    Definition init
      : I.context ->
        I.key ->
          I.value ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                (Tezos_raw_protocol_alpha.Raw_context.t * Z)) := I.init.
    
    Definition init_set
      : I.context ->
        I.key ->
          I.value ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool)) :=
      I.init_set.
    
    Definition consume_deserialize_gas
      (ctxt : Raw_context.context)
      (value : Tezos_raw_protocol_alpha.Script_repr.expr)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Raw_context.context) :=
      op_atat Lwt.__return
        (Raw_context.consume_gas ctxt (Script_repr.deserialized_cost value)).
    
    Definition get (ctxt : I.context) (contract : I.key)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Raw_context.context * I.value)) :=
      op_gtgteqquestion (I.get ctxt contract)
        (fun function_parameter =>
          let '(ctxt, value) := function_parameter in
          op_gtgtpipequestion (consume_deserialize_gas ctxt value)
            (fun ctxt => (ctxt, value))).
    
    Definition get_option (ctxt : I.context) (contract : I.key)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * option I.value)) :=
      op_gtgteqquestion (I.get_option ctxt contract)
        (fun function_parameter =>
          let '(ctxt, value_opt) := function_parameter in
          match value_opt with
          | None => __return (ctxt, None)
          | Some value =>
            op_gtgtpipequestion (consume_deserialize_gas ctxt value)
              (fun ctxt => (ctxt, value_opt))
          end).
  End Contents.
End Big_map.

(* ❌ Applications of functors are not handled. *)
functor_application

(* ❌ Applications of functors are not handled. *)
functor_application

(* ❌ Applications of functors are not handled. *)
functor_application

(* ❌ Applications of functors are not handled. *)
functor_application

Module Cycle.
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  Record unrevealed_nonce := {
    nonce_hash : Tezos_raw_protocol_alpha.Nonce_hash.t;
    delegate :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
    rewards : Tezos_raw_protocol_alpha.Tez_repr.t;
    fees : Tezos_raw_protocol_alpha.Tez_repr.t }.
  
  Inductive nonce_status : Type :=
  | Unrevealed : unrevealed_nonce -> nonce_status
  | Revealed : Tezos_raw_protocol_alpha.Seed_repr.nonce -> nonce_status.
  
  Definition nonce_status_encoding
    : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
      nonce_status :=
    union None
      (cons
        (case "Unrevealed" % string None
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
          (tup4 Nonce_hash.encoding Signature.Public_key_hash.encoding
            Tez_repr.encoding Tez_repr.encoding)
          (fun function_parameter =>
            match function_parameter with
            |
              Unrevealed {|
                nonce_hash := nonce_hash;
                  delegate := delegate;
                  rewards := rewards;
                  fees := fees
                  |} => Some (nonce_hash, delegate, rewards, fees)
            | _ => None
            end)
          (fun function_parameter =>
            let '(nonce_hash, delegate, rewards, fees) := function_parameter in
            Unrevealed
              {| nonce_hash := nonce_hash; delegate := delegate;
                rewards := rewards; fees := fees |}))
        (cons
          (case "Revealed" % string None
            (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
            Seed_repr.nonce_encoding
            (fun function_parameter =>
              match function_parameter with
              | Revealed nonce => Some nonce
              | _ => None
              end) (fun nonce => Revealed nonce)) [])).
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
End Cycle.

Module Roll.
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  Module Snapshoted_owner_index.
    Definition t := Tezos_raw_protocol_alpha.Cycle_repr.t * Z.
    
    Definition path_length : Z := op_plus Cycle_repr.Index.path_length 1.
    
    Definition to_path
      (function_parameter : Tezos_raw_protocol_alpha.Cycle_repr.Index.t * Z)
      : list string -> list string :=
      let '(c, n) := function_parameter in
      fun s => Cycle_repr.Index.to_path c (cons (string_of_int n) s).
    
    Definition of_path (l : list string)
      : option (Tezos_raw_protocol_alpha.Cycle_repr.Index.t * Z) :=
      match Misc.take Cycle_repr.Index.path_length l with
      | None | Some (_, [] | cons _ (cons _ _)) => None
      | Some (l1, cons l2 []) =>
        match ((Cycle_repr.Index.of_path l1), (int_of_string_opt l2)) with
        | (None, _) | (_, None) => None
        | (Some c, Some i) => Some (c, i)
        end
      end.
    
    Definition ipath (a : Type) :=
      (a * Tezos_raw_protocol_alpha.Cycle_repr.t) * Z.
    
    Definition left_args {A : Type}
      : Tezos_raw_protocol_alpha.Storage_description.args A
        Tezos_raw_protocol_alpha.Cycle_repr.cycle
        (A * Tezos_raw_protocol_alpha.Cycle_repr.cycle) :=
      Tezos_raw_protocol_alpha.Storage_description.One
        {| rpc_arg := Cycle_repr.rpc_arg; encoding := Cycle_repr.encoding;
          compare := Cycle_repr.compare |}.
    
    Definition right_args {A : Type}
      : Tezos_raw_protocol_alpha.Storage_description.args A
        Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t)
        (A *
          Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t)) :=
      Tezos_raw_protocol_alpha.Storage_description.One
        {| rpc_arg := RPC_arg.int; encoding := Data_encoding.int31;
          compare :=
            Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.compare)
          |}.
    
    Definition args {A : Type}
      : Tezos_raw_protocol_alpha.Storage_description.args A
        (Tezos_raw_protocol_alpha.Cycle_repr.cycle *
          Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
        ((A * Tezos_raw_protocol_alpha.Cycle_repr.cycle) *
          Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t)) :=
      Tezos_raw_protocol_alpha.Storage_description.Pair left_args right_args.
  End Snapshoted_owner_index.
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  Module Snapshot_for_cycle := Cycle.Roll_snapshot.
  
  Module Last_for_snapshot := Cycle.Last_roll.
  
  Definition clear
    : Indexed_context.context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t := Indexed_context.clear.
End Roll.

Module Vote.
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
End Vote.

Module Seed.
  Record unrevealed_nonce := {
    nonce_hash : Tezos_raw_protocol_alpha.Nonce_hash.t;
    delegate :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
    rewards : Tezos_raw_protocol_alpha.Tez_repr.t;
    fees : Tezos_raw_protocol_alpha.Tez_repr.t }.
  
  Inductive nonce_status : Type :=
  | Unrevealed : unrevealed_nonce -> nonce_status
  | Revealed : Tezos_raw_protocol_alpha.Seed_repr.nonce -> nonce_status.
  
  Module Nonce.
    Import Level_repr.
    
    Definition context := Tezos_raw_protocol_alpha.Raw_context.t.
    
    Definition mem
      (ctxt : Cycle.Indexed_context.t)
      (l : Tezos_raw_protocol_alpha.Level_repr.t)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t bool :=
      Cycle.Nonce.mem (ctxt, (cycle l)) (level l).
    
    Definition get
      (ctxt : Cycle.Indexed_context.t)
      (l : Tezos_raw_protocol_alpha.Level_repr.t)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Cycle.Nonce.value) := Cycle.Nonce.get (ctxt, (cycle l)) (level l).
    
    Definition get_option
      (ctxt : Cycle.Indexed_context.t)
      (l : Tezos_raw_protocol_alpha.Level_repr.t)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option Cycle.Nonce.value)) :=
      Cycle.Nonce.get_option (ctxt, (cycle l)) (level l).
    
    Definition set
      (ctxt : Cycle.Indexed_context.t)
      (l : Tezos_raw_protocol_alpha.Level_repr.t) (v : Cycle.Nonce.value)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t) :=
      Cycle.Nonce.set (ctxt, (cycle l)) (level l) v.
    
    Definition init
      (ctxt : Cycle.Indexed_context.t)
      (l : Tezos_raw_protocol_alpha.Level_repr.t) (v : Cycle.Nonce.value)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t) :=
      Cycle.Nonce.init (ctxt, (cycle l)) (level l) v.
    
    Definition init_set
      (ctxt : Cycle.Indexed_context.t)
      (l : Tezos_raw_protocol_alpha.Level_repr.t) (v : Cycle.Nonce.value)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t :=
      Cycle.Nonce.init_set (ctxt, (cycle l)) (level l) v.
    
    Definition set_option
      (ctxt : Cycle.Indexed_context.t)
      (l : Tezos_raw_protocol_alpha.Level_repr.t) (v : option Cycle.Nonce.value)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t :=
      Cycle.Nonce.set_option (ctxt, (cycle l)) (level l) v.
    
    Definition delete
      (ctxt : Cycle.Indexed_context.t)
      (l : Tezos_raw_protocol_alpha.Level_repr.t)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t) :=
      Cycle.Nonce.delete (ctxt, (cycle l)) (level l).
    
    Definition remove
      (ctxt : Cycle.Indexed_context.t)
      (l : Tezos_raw_protocol_alpha.Level_repr.t)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t :=
      Cycle.Nonce.remove (ctxt, (cycle l)) (level l).
  End Nonce.
  
  Module For_cycle := Cycle.Seed.
End Seed.

(* ❌ Applications of functors are not handled. *)
functor_application

Module Ramp_up.
  (* ❌ Applications of functors are not handled. *)
  functor_application
  
  (* ❌ Applications of functors are not handled. *)
  functor_application
End Ramp_up.
storage.mli 42 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Tezos Protocol Implementation - Typed storage

    This module hides the hierarchical (key x value) database under
    pre-allocated typed accessors for all persistent entities of the
    tezos context.

    This interface enforces no invariant on the contents of the
    database. Its goal is to centralize all accessors in order to have
    a complete view over the database contents and avoid key
    collisions. *)

open Storage_sigs

module Block_priority : sig
  val get : Raw_context.t -> int tzresult Lwt.t

  val set : Raw_context.t -> int -> Raw_context.t tzresult Lwt.t

  val init : Raw_context.t -> int -> Raw_context.t tzresult Lwt.t
end

module Roll : sig
  (** Storage from this submodule must only be accessed through the
      module `Roll`. *)

  module Owner :
    Indexed_data_snapshotable_storage
      with type key = Roll_repr.t
       and type snapshot = Cycle_repr.t * int
       and type value = Signature.Public_key.t
       and type t := Raw_context.t

  val clear : Raw_context.t -> Raw_context.t Lwt.t

  (** The next roll to be allocated. *)
  module Next :
    Single_data_storage
      with type value = Roll_repr.t
       and type t := Raw_context.t

  (** Rolls linked lists represent both account owned and free rolls.
      All rolls belongs either to the limbo list or to an owned list. *)

  (** Head of the linked list of rolls in limbo *)
  module Limbo :
    Single_data_storage
      with type value = Roll_repr.t
       and type t := Raw_context.t

  (** Rolls associated to contracts, a linked list per contract *)
  module Delegate_roll_list :
    Indexed_data_storage
      with type key = Signature.Public_key_hash.t
       and type value = Roll_repr.t
       and type t := Raw_context.t

  (** Use this to iter on a linked list of rolls *)
  module Successor :
    Indexed_data_storage
      with type key = Roll_repr.t
       and type value = Roll_repr.t
       and type t := Raw_context.t

  (** The tez of a contract that are not assigned to rolls *)
  module Delegate_change :
    Indexed_data_storage
      with type key = Signature.Public_key_hash.t
       and type value = Tez_repr.t
       and type t := Raw_context.t

  (** Index of the randomly selected roll snapshot of a given cycle. *)
  module Snapshot_for_cycle :
    Indexed_data_storage
      with type key = Cycle_repr.t
       and type value = int
       and type t := Raw_context.t

  (** Last roll in the snapshoted roll allocation of a given cycle. *)
  module Last_for_snapshot :
    Indexed_data_storage
      with type key = int
       and type value = Roll_repr.t
       and type t = Raw_context.t * Cycle_repr.t
end

module Contract : sig
  (** Storage from this submodule must only be accessed through the
      module `Contract`. *)

  module Global_counter : sig
    val get : Raw_context.t -> Z.t tzresult Lwt.t

    val set : Raw_context.t -> Z.t -> Raw_context.t tzresult Lwt.t

    val init : Raw_context.t -> Z.t -> Raw_context.t tzresult Lwt.t
  end

  (** The domain of alive contracts *)
  val fold :
    Raw_context.t ->
    init:'a ->
    f:(Contract_repr.t -> 'a -> 'a Lwt.t) ->
    'a Lwt.t

  val list : Raw_context.t -> Contract_repr.t list Lwt.t

  (** All the tez possesed by a contract, including rolls and change *)
  module Balance :
    Indexed_data_storage
      with type key = Contract_repr.t
       and type value = Tez_repr.t
       and type t := Raw_context.t

  (** Frozen balance, see 'delegate_storage.mli' for more explanation.
      Always update `Delegates_with_frozen_balance` accordingly. *)
  module Frozen_deposits :
    Indexed_data_storage
      with type key = Cycle_repr.t
       and type value = Tez_repr.t
       and type t = Raw_context.t * Contract_repr.t

  module Frozen_fees :
    Indexed_data_storage
      with type key = Cycle_repr.t
       and type value = Tez_repr.t
       and type t = Raw_context.t * Contract_repr.t

  module Frozen_rewards :
    Indexed_data_storage
      with type key = Cycle_repr.t
       and type value = Tez_repr.t
       and type t = Raw_context.t * Contract_repr.t

  (** The manager of a contract *)
  module Manager :
    Indexed_data_storage
      with type key = Contract_repr.t
       and type value = Manager_repr.t
       and type t := Raw_context.t

  (** The delegate of a contract, if any. *)
  module Delegate :
    Indexed_data_storage
      with type key = Contract_repr.t
       and type value = Signature.Public_key_hash.t
       and type t := Raw_context.t

  (** All contracts (implicit and originated) that are delegated, if any  *)
  module Delegated :
    Data_set_storage
      with type elt = Contract_repr.t
       and type t = Raw_context.t * Contract_repr.t

  module Inactive_delegate :
    Data_set_storage with type elt = Contract_repr.t and type t = Raw_context.t

  (** The cycle where the delegate should be desactivated. *)
  module Delegate_desactivation :
    Indexed_data_storage
      with type key = Contract_repr.t
       and type value = Cycle_repr.t
       and type t := Raw_context.t

  module Counter :
    Indexed_data_storage
      with type key = Contract_repr.t
       and type value = Z.t
       and type t := Raw_context.t

  module Code :
    Non_iterable_indexed_carbonated_data_storage
      with type key = Contract_repr.t
       and type value = Script_repr.lazy_expr
       and type t := Raw_context.t

  module Storage :
    Non_iterable_indexed_carbonated_data_storage
      with type key = Contract_repr.t
       and type value = Script_repr.lazy_expr
       and type t := Raw_context.t

  (** Current storage space in bytes.
      Includes code, global storage and big map elements. *)
  module Used_storage_space :
    Indexed_data_storage
      with type key = Contract_repr.t
       and type value = Z.t
       and type t := Raw_context.t

  (** Maximal space available without needing to burn new fees. *)
  module Paid_storage_space :
    Indexed_data_storage
      with type key = Contract_repr.t
       and type value = Z.t
       and type t := Raw_context.t
end

module Big_map : sig
  module Next : sig
    val incr : Raw_context.t -> (Raw_context.t * Z.t) tzresult Lwt.t

    val init : Raw_context.t -> Raw_context.t tzresult Lwt.t
  end

  (** The domain of alive big maps *)
  val fold : Raw_context.t -> init:'a -> f:(Z.t -> 'a -> 'a Lwt.t) -> 'a Lwt.t

  val list : Raw_context.t -> Z.t list Lwt.t

  val remove_rec : Raw_context.t -> Z.t -> Raw_context.t Lwt.t

  val copy :
    Raw_context.t -> from:Z.t -> to_:Z.t -> Raw_context.t tzresult Lwt.t

  type key = Raw_context.t * Z.t

  val rpc_arg : Z.t RPC_arg.t

  module Contents :
    Non_iterable_indexed_carbonated_data_storage
      with type key = Script_expr_hash.t
       and type value = Script_repr.expr
       and type t := key

  module Total_bytes :
    Indexed_data_storage
      with type key = Z.t
       and type value = Z.t
       and type t := Raw_context.t

  module Key_type :
    Indexed_data_storage
      with type key = Z.t
       and type value = Script_repr.expr
       and type t := Raw_context.t

  module Value_type :
    Indexed_data_storage
      with type key = Z.t
       and type value = Script_repr.expr
       and type t := Raw_context.t
end

(** Set of all registered delegates. *)
module Delegates :
  Data_set_storage
    with type t := Raw_context.t
     and type elt = Signature.Public_key_hash.t

(** Set of all active delegates with rolls. *)
module Active_delegates_with_rolls :
  Data_set_storage
    with type t := Raw_context.t
     and type elt = Signature.Public_key_hash.t

(** Set of all the delegates with frozen rewards/bonds/fees for a given cycle. *)
module Delegates_with_frozen_balance :
  Data_set_storage
    with type t = Raw_context.t * Cycle_repr.t
     and type elt = Signature.Public_key_hash.t

(** Votes *)

module Vote : sig
  module Current_period_kind :
    Single_data_storage
      with type value = Voting_period_repr.kind
       and type t := Raw_context.t

  (** Participation exponential moving average, in centile of percentage *)
  module Participation_ema :
    Single_data_storage with type value = int32 and type t := Raw_context.t

  module Current_proposal :
    Single_data_storage
      with type value = Protocol_hash.t
       and type t := Raw_context.t

  (** Sum of all rolls of all delegates. *)
  module Listings_size :
    Single_data_storage with type value = int32 and type t := Raw_context.t

  (** Contains all delegates with their assigned number of rolls. *)
  module Listings :
    Indexed_data_storage
      with type key = Signature.Public_key_hash.t
       and type value = int32
       and type t := Raw_context.t

  (** Set of protocol proposal with corresponding proposer delegate *)
  module Proposals :
    Data_set_storage
      with type elt = Protocol_hash.t * Signature.Public_key_hash.t
       and type t := Raw_context.t

  (** Keeps for each delegate the number of proposed protocols *)
  module Proposals_count :
    Indexed_data_storage
      with type key = Signature.Public_key_hash.t
       and type value = int
       and type t := Raw_context.t

  (** Contains for each delegate its ballot *)
  module Ballots :
    Indexed_data_storage
      with type key = Signature.Public_key_hash.t
       and type value = Vote_repr.ballot
       and type t := Raw_context.t
end

(** Seed *)

module Seed : sig
  (** Storage from this submodule must only be accessed through the
      module `Seed`. *)

  type unrevealed_nonce = {
    nonce_hash : Nonce_hash.t;
    delegate : Signature.Public_key_hash.t;
    rewards : Tez_repr.t;
    fees : Tez_repr.t;
  }

  type nonce_status =
    | Unrevealed of unrevealed_nonce
    | Revealed of Seed_repr.nonce

  module Nonce :
    Non_iterable_indexed_data_storage
      with type key := Level_repr.t
       and type value := nonce_status
       and type t := Raw_context.t

  module For_cycle : sig
    val init :
      Raw_context.t ->
      Cycle_repr.t ->
      Seed_repr.seed ->
      Raw_context.t tzresult Lwt.t

    val get : Raw_context.t -> Cycle_repr.t -> Seed_repr.seed tzresult Lwt.t

    val delete : Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t
  end
end

(** Commitments *)

module Commitments :
  Indexed_data_storage
    with type key = Blinded_public_key_hash.t
     and type value = Tez_repr.t
     and type t := Raw_context.t

(** Ramp up security deposits... *)

module Ramp_up : sig
  module Rewards :
    Indexed_data_storage
      with type key = Cycle_repr.t
       and type value = Tez_repr.t * Tez_repr.t
      (* baking * endorsement *)
       and type t := Raw_context.t

  module Security_deposits :
    Indexed_data_storage
      with type key = Cycle_repr.t
       and type value = Tez_repr.t * Tez_repr.t
      (* baking * endorsement *)
       and type t := Raw_context.t
end
storage_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module Block_priority.
  Parameter get : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z).
  
  Parameter set : Tezos_raw_protocol_alpha.Raw_context.t ->
    Z ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
  
  Parameter init : Tezos_raw_protocol_alpha.Raw_context.t ->
    Z ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
End Block_priority.

Module Roll.
  unhandled_module
  
  Parameter clear : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.t.
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
End Roll.

Module Contract.
  Module Global_counter.
    Parameter get : Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_protocol_environment_alpha__Environment.Z.t).
    
    Parameter set : Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_protocol_environment_alpha__Environment.Z.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter init : Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_protocol_environment_alpha__Environment.Z.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Raw_context.t).
  End Global_counter.
  
  Parameter fold : forall {a : Type}, Tezos_raw_protocol_alpha.Raw_context.t ->
    a ->
      (Tezos_raw_protocol_alpha.Contract_repr.t ->
        a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  
  Parameter list : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (list Tezos_raw_protocol_alpha.Contract_repr.t).
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
End Contract.

Module Big_map.
  Module Next.
    Parameter incr : Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t *
            Tezos_protocol_environment_alpha__Environment.Z.t)).
    
    Parameter init : Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).
  End Next.
  
  Parameter fold : forall {a : Type}, Tezos_raw_protocol_alpha.Raw_context.t ->
    a ->
      (Tezos_protocol_environment_alpha__Environment.Z.t ->
        a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t a.
  
  Parameter list : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (list Tezos_protocol_environment_alpha__Environment.Z.t).
  
  Parameter remove_rec : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t.
  
  Parameter copy : Tezos_raw_protocol_alpha.Raw_context.t ->
    Tezos_protocol_environment_alpha__Environment.Z.t ->
      Tezos_protocol_environment_alpha__Environment.Z.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Raw_context.t).
  
  Definition key :=
    Tezos_raw_protocol_alpha.Raw_context.t *
      Tezos_protocol_environment_alpha__Environment.Z.t.
  
  Parameter rpc_arg : Tezos_protocol_environment_alpha__Environment.RPC_arg.t
    Tezos_protocol_environment_alpha__Environment.Z.t.
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
End Big_map.

unhandled_module

unhandled_module

unhandled_module

Module Vote.
  unhandled_module
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
  
  unhandled_module
End Vote.

Module Seed.
  Record unrevealed_nonce := {
    nonce_hash : Tezos_raw_protocol_alpha.Nonce_hash.t;
    delegate :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t;
    rewards : Tezos_raw_protocol_alpha.Tez_repr.t;
    fees : Tezos_raw_protocol_alpha.Tez_repr.t }.
  
  Inductive nonce_status : Type :=
  | Unrevealed : unrevealed_nonce -> nonce_status
  | Revealed : Tezos_raw_protocol_alpha.Seed_repr.nonce -> nonce_status.
  
  unhandled_module
  
  Module For_cycle.
    Parameter init : Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_raw_protocol_alpha.Cycle_repr.t ->
        Tezos_raw_protocol_alpha.Seed_repr.seed ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              Tezos_raw_protocol_alpha.Raw_context.t).
    
    Parameter get : Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_raw_protocol_alpha.Cycle_repr.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Seed_repr.seed).
    
    Parameter delete : Tezos_raw_protocol_alpha.Raw_context.t ->
      Tezos_raw_protocol_alpha.Cycle_repr.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Raw_context.t).
  End For_cycle.
End Seed.

unhandled_module

Module Ramp_up.
  unhandled_module
  
  unhandled_module
End Ramp_up.
storage_description.ml 27 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

module StringMap = Map.Make (String)

type 'key t = 'key description ref

and 'key description =
  | Empty : 'key description
  | Value : {
      get : 'key -> 'a option tzresult Lwt.t;
      encoding : 'a Data_encoding.t;
    }
      -> 'key description
  | NamedDir : 'key t StringMap.t -> 'key description
  | IndexedDir : {
      arg : 'a RPC_arg.t;
      arg_encoding : 'a Data_encoding.t;
      list : 'key -> 'a list tzresult Lwt.t;
      subdir : ('key * 'a) t;
    }
      -> 'key description

let rec register_named_subcontext : type r. r t -> string list -> r t =
 fun dir names ->
  match (!dir, names) with
  | (_, []) ->
      dir
  | (Value _, _) ->
      invalid_arg ""
  | (IndexedDir _, _) ->
      invalid_arg ""
  | (Empty, name :: names) ->
      let subdir = ref Empty in
      dir := NamedDir (StringMap.singleton name subdir) ;
      register_named_subcontext subdir names
  | (NamedDir map, name :: names) ->
      let subdir =
        match StringMap.find_opt name map with
        | Some subdir ->
            subdir
        | None ->
            let subdir = ref Empty in
            dir := NamedDir (StringMap.add name subdir map) ;
            subdir
      in
      register_named_subcontext subdir names

type (_, _, _) args =
  | One : {
      rpc_arg : 'a RPC_arg.t;
      encoding : 'a Data_encoding.t;
      compare : 'a -> 'a -> int;
    }
      -> ('key, 'a, 'key * 'a) args
  | Pair :
      ('key, 'a, 'inter_key) args * ('inter_key, 'b, 'sub_key) args
      -> ('key, 'a * 'b, 'sub_key) args

let rec unpack : type a b c. (a, b, c) args -> c -> a * b = function
  | One _ ->
      fun x -> x
  | Pair (l, r) ->
      let unpack_l = unpack l in
      let unpack_r = unpack r in
      fun x ->
        let (c, d) = unpack_r x in
        let (b, a) = unpack_l c in
        (b, (a, d))

let rec pack : type a b c. (a, b, c) args -> a -> b -> c = function
  | One _ ->
      fun b a -> (b, a)
  | Pair (l, r) ->
      let pack_l = pack l in
      let pack_r = pack r in
      fun b (a, d) ->
        let c = pack_l b a in
        pack_r c d

let rec compare : type a b c. (a, b, c) args -> b -> b -> int = function
  | One {compare; _} ->
      compare
  | Pair (l, r) -> (
      let compare_l = compare l in
      let compare_r = compare r in
      fun (a1, b1) (a2, b2) ->
        match compare_l a1 a2 with 0 -> compare_r b1 b2 | x -> x )

let destutter equal l =
  match l with
  | [] ->
      []
  | (i, _) :: l ->
      let rec loop acc i = function
        | [] ->
            acc
        | (j, _) :: l ->
            if equal i j then loop acc i l else loop (j :: acc) j l
      in
      loop [i] i l

let rec register_indexed_subcontext :
    type r a b.
    r t -> list:(r -> a list tzresult Lwt.t) -> (r, a, b) args -> b t =
 fun dir ~list path ->
  match path with
  | Pair (left, right) ->
      let compare_left = compare left in
      let equal_left x y = Compare.Int.(compare_left x y = 0) in
      let list_left r = list r >>=? fun l -> return (destutter equal_left l) in
      let list_right r =
        let (a, k) = unpack left r in
        list a
        >>=? fun l ->
        return (List.map snd (List.filter (fun (x, _) -> equal_left x k) l))
      in
      register_indexed_subcontext
        (register_indexed_subcontext dir ~list:list_left left)
        ~list:list_right
        right
  | One {rpc_arg = arg; encoding = arg_encoding; _} -> (
    match !dir with
    | Value _ ->
        invalid_arg ""
    | NamedDir _ ->
        invalid_arg ""
    | Empty ->
        let subdir = ref Empty in
        dir := IndexedDir {arg; arg_encoding; list; subdir} ;
        subdir
    | IndexedDir {arg = inner_arg; subdir; _} -> (
      match RPC_arg.eq arg inner_arg with
      | None ->
          invalid_arg ""
      | Some RPC_arg.Eq ->
          subdir ) )

let register_value :
    type a b.
    a t -> get:(a -> b option tzresult Lwt.t) -> b Data_encoding.t -> unit =
 fun dir ~get encoding ->
  match !dir with Empty -> dir := Value {get; encoding} | _ -> invalid_arg ""

let create () = ref Empty

let rec pp : type a. Format.formatter -> a t -> unit =
 fun ppf dir ->
  match !dir with
  | Empty ->
      Format.fprintf ppf "EMPTY"
  | Value _e ->
      Format.fprintf ppf "Value"
  | NamedDir map ->
      Format.fprintf
        ppf
        "@[<v>%a@]"
        (Format.pp_print_list pp_item)
        (StringMap.bindings map)
  | IndexedDir {arg; subdir; _} ->
      let name = Format.asprintf "<%s>" (RPC_arg.descr arg).name in
      pp_item ppf (name, subdir)

and pp_item : type a. Format.formatter -> string * a t -> unit =
 fun ppf (name, dir) -> Format.fprintf ppf "@[<v 2>%s@ %a@]" name pp dir

module type INDEX = sig
  type t

  val path_length : int

  val to_path : t -> string list -> string list

  val of_path : string list -> t option

  val rpc_arg : t RPC_arg.t

  val encoding : t Data_encoding.t

  val compare : t -> t -> int
end

type _ handler =
  | Handler : {
      encoding : 'a Data_encoding.t;
      get : 'key -> int -> 'a tzresult Lwt.t;
    }
      -> 'key handler

type _ opt_handler =
  | Opt_handler : {
      encoding : 'a Data_encoding.t;
      get : 'key -> int -> 'a option tzresult Lwt.t;
    }
      -> 'key opt_handler

let rec combine_object = function
  | [] ->
      Handler {encoding = Data_encoding.unit; get = (fun _ _ -> return_unit)}
  | (name, Opt_handler handler) :: fields ->
      let (Handler handlers) = combine_object fields in
      Handler
        {
          encoding =
            Data_encoding.merge_objs
              Data_encoding.(obj1 (opt name (dynamic_size handler.encoding)))
              handlers.encoding;
          get =
            (fun k i ->
              handler.get k i
              >>=? fun v1 -> handlers.get k i >>=? fun v2 -> return (v1, v2));
        }

type query = {depth : int}

let depth_query =
  let open RPC_query in
  query (fun depth -> {depth})
  |+ field "depth" RPC_arg.int 0 (fun t -> t.depth)
  |> seal

let build_directory : type key. key t -> key RPC_directory.t =
 fun dir ->
  let rpc_dir = ref (RPC_directory.empty : key RPC_directory.t) in
  let register : type ikey. (key, ikey) RPC_path.t -> ikey opt_handler -> unit
      =
   fun path (Opt_handler {encoding; get}) ->
    let service =
      RPC_service.get_service ~query:depth_query ~output:encoding path
    in
    rpc_dir :=
      RPC_directory.register !rpc_dir service (fun k q () ->
          get k (q.depth + 1)
          >>=? function None -> raise Not_found | Some x -> return x)
  in
  let rec build_handler :
      type ikey. ikey t -> (key, ikey) RPC_path.t -> ikey opt_handler =
   fun dir path ->
    match !dir with
    | Empty ->
        Opt_handler
          {encoding = Data_encoding.unit; get = (fun _ _ -> return_none)}
    | Value {get; encoding} ->
        let handler =
          Opt_handler
            {
              encoding;
              get =
                (fun k i -> if Compare.Int.(i < 0) then return_none else get k);
            }
        in
        register path handler ; handler
    | NamedDir map ->
        let fields = StringMap.bindings map in
        let fields =
          List.map
            (fun (name, dir) ->
              (name, build_handler dir RPC_path.(path / name)))
            fields
        in
        let (Handler handler) = combine_object fields in
        let handler =
          Opt_handler
            {
              encoding = handler.encoding;
              get =
                (fun k i ->
                  if Compare.Int.(i < 0) then return_none
                  else handler.get k (i - 1) >>=? fun v -> return_some v);
            }
        in
        register path handler ; handler
    | IndexedDir {arg; arg_encoding; list; subdir} ->
        let (Opt_handler handler) =
          build_handler subdir RPC_path.(path /: arg)
        in
        let encoding =
          let open Data_encoding in
          union
            [ case
                (Tag 0)
                ~title:"Leaf"
                (dynamic_size arg_encoding)
                (function (key, None) -> Some key | _ -> None)
                (fun key -> (key, None));
              case
                (Tag 1)
                ~title:"Dir"
                (tup2
                   (dynamic_size arg_encoding)
                   (dynamic_size handler.encoding))
                (function (key, Some value) -> Some (key, value) | _ -> None)
                (fun (key, value) -> (key, Some value)) ]
        in
        let get k i =
          if Compare.Int.(i < 0) then return_none
          else if Compare.Int.(i = 0) then return_some []
          else
            list k
            >>=? fun keys ->
            map_s
              (fun key ->
                if Compare.Int.(i = 1) then return (key, None)
                else
                  handler.get (k, key) (i - 1)
                  >>=? fun value -> return (key, value))
              keys
            >>=? fun values -> return_some values
        in
        let handler =
          Opt_handler
            {encoding = Data_encoding.(list (dynamic_size encoding)); get}
        in
        register path handler ; handler
  in
  ignore (build_handler dir RPC_path.open_root : key opt_handler) ;
  !rpc_dir
storage_description_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* ❌ Applications of functors are not handled. *)
functor_application

Reserved Notation "'t".
Reserved Notation "'description".

Inductive description_gadt : Type :=
| Empty : description_gadt
| Value : forall {a key : Type},
  (key ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (option a))) ->
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
  description_gadt
| NamedDir : forall {key : Type},
  StringMap.(Tezos_protocol_environment_alpha__Environment.MAP.S.t) ('t key) ->
  description_gadt
| IndexedDir : forall {a key : Type},
  Tezos_protocol_environment_alpha__Environment.RPC_arg.t a ->
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
  (key ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (list a))) -> 't (key * a) -> description_gadt

where "'t" := (fun (key : Type) =>
  Tezos_protocol_environment_alpha__Environment.Pervasives.ref
    ('description key))
and "'description" := (fun (key : Type) => description_gadt).

Definition t := 't.
Definition description := 'description.

Fixpoint register_named_subcontext {r : Type} (dir : t r) (names : list string)
  : t r :=
  match ((op_exclamation dir), names) with
  | (_, []) => dir
  | (Value _, _) => invalid_arg "" % string
  | (IndexedDir _, _) => invalid_arg "" % string
  | (Empty, cons name names) =>
    let subdir := ref Empty in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ :=
      op_coloneq dir
        (NamedDir
          (StringMap.(Tezos_protocol_environment_alpha__Environment.MAP.S.singleton)
            name subdir)) in
    register_named_subcontext subdir names
  | (NamedDir map, cons name names) =>
    let subdir :=
      match
        StringMap.(Tezos_protocol_environment_alpha__Environment.MAP.S.find_opt)
          name map with
      | Some subdir => subdir
      | None =>
        let subdir := ref Empty in
        (* ❌ Sequences of instructions are not handled (operator ";") *)
        let _ :=
          op_coloneq dir
            (NamedDir
              (StringMap.(Tezos_protocol_environment_alpha__Environment.MAP.S.add)
                name subdir map)) in
        subdir
      end in
    register_named_subcontext subdir names
  end.

Reserved Notation "'args".

Inductive args_gadt : Type :=
| One : forall {a : Type},
  Tezos_protocol_environment_alpha__Environment.RPC_arg.t a ->
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
  (a -> a -> Z) -> args_gadt
| Pair : args_gadt -> args_gadt -> args_gadt

where "'args" := (fun (_ _ _ : Type) => args_gadt).

Definition args := 'args.

Fixpoint unpack {a b c : Type} (function_parameter : args a b c) : c -> a * b :=
  match function_parameter with
  | One _ => fun x => x
  | Pair l r =>
    let unpack_l := unpack l in
    let unpack_r := unpack r in
    fun x =>
      let '(c, d) := unpack_r x in
      let '(b, a) := unpack_l c in
      (b, (a, d))
  end.

Fixpoint pack {a b c : Type} (function_parameter : args a b c) : a -> b -> c :=
  match function_parameter with
  | One _ => fun b => fun a => (b, a)
  | Pair l r =>
    let pack_l := pack l in
    let pack_r := pack r in
    fun b =>
      fun function_parameter =>
        let '(a, d) := function_parameter in
        let c := pack_l b a in
        pack_r c d
  end.

Fixpoint compare {a b c : Type} (function_parameter : args a b c)
  : b -> b -> Z :=
  match function_parameter with
  | One {| compare := compare |} => compare
  | Pair l r =>
    let compare_l := compare l in
    let compare_r := compare r in
    fun function_parameter =>
      let '(a1, b1) := function_parameter in
      fun function_parameter =>
        let '(a2, b2) := function_parameter in
        match compare_l a1 a2 with
        | 0 => compare_r b1 b2
        | x => x
        end
  end.

Definition destutter {A B : Type} (equal : A -> A -> bool) (l : list (A * B))
  : list A :=
  match l with
  | [] => []
  | cons (i, _) l =>
    let fix loop {C : Type}
      (acc : list A) (i : A) (function_parameter : list (A * C)) : list A :=
      match function_parameter with
      | [] => acc
      | cons (j, _) l =>
        if equal i j then
          loop acc i l
        else
          loop (cons j acc) j l
      end in
    loop (cons i []) i l
  end.

Fixpoint register_indexed_subcontext {a b r : Type}
  (dir : t r)
  (list :
    r ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (list a))) (path : args r a b) : t b :=
  match path with
  | Pair left right =>
    let compare_left := compare left in
    let equal_left (x : op_dollar0) (y : op_dollar0) : bool :=
      Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
        (compare_left x y) 0 in
    let list_left (r : r)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (list op_dollar0)) :=
      op_gtgteqquestion (list r) (fun l => __return (destutter equal_left l)) in
    let list_right (r : op_dollarPair_'inter_key)
      : Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (list op_dollar1)) :=
      let '(a, k) := unpack left r in
      op_gtgteqquestion (list a)
        (fun l =>
          __return
            (List.map snd
              (List.filter
                (fun function_parameter =>
                  let '(x, _) := function_parameter in
                  equal_left x k) l))) in
    register_indexed_subcontext (register_indexed_subcontext dir list_left left)
      list_right right
  | One {| rpc_arg := arg; encoding := arg_encoding |} =>
    match op_exclamation dir with
    | Value _ => invalid_arg "" % string
    | NamedDir _ => invalid_arg "" % string
    | Empty =>
      let subdir := ref Empty in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ :=
        op_coloneq dir
          (IndexedDir
            {| arg := arg; arg_encoding := arg_encoding; list := list;
              subdir := subdir |}) in
      subdir
    | IndexedDir {| arg := inner_arg; subdir := subdir |} =>
      match RPC_arg.eq arg inner_arg with
      | None => invalid_arg "" % string
      | Some Tezos_protocol_environment_alpha__Environment.RPC_arg.Eq => subdir
      end
    end
  end.

Definition register_value {a b : Type}
  (dir : t a)
  (get :
    a ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option b)))
  (encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t b)
  : unit :=
  match op_exclamation dir with
  | Empty => op_coloneq dir (Value {| get := get; encoding := encoding |})
  | _ => invalid_arg "" % string
  end.

Definition create {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Pervasives.ref (description A) :=
  let 'tt := function_parameter in
  ref Empty.

Fixpoint pp {a : Type}
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (dir : t a) : unit :=
  match op_exclamation dir with
  | Empty =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
          "EMPTY" % string
          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
        "EMPTY" % string)
  | Value _e =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
          "Value" % string
          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
        "Value" % string)
  | NamedDir map =>
    Format.fprintf ppf
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_gen
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Open_box
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "<v>" % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "<v>" % string))
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Close_box
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
        "@[<v>%a@]" % string) (Format.pp_print_list None pp_item)
      (StringMap.(Tezos_protocol_environment_alpha__Environment.MAP.S.bindings)
        map)
  | IndexedDir {| arg := arg; subdir := subdir |} =>
    let name :=
      Format.asprintf
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
            "<" % char
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Char_literal
                ">" % char
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))
          "<%s>" % string) (name (RPC_arg.descr arg)) in
    pp_item ppf (name, subdir)
  end

with pp_item {a : Type}
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (function_parameter : string * t a) : unit :=
  let '(name, dir) := function_parameter in
  Format.fprintf ppf
    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_gen
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Open_box
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
              "<v 2>" % string
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
            "<v 2>" % string))
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Break
              "@ " % string 1 0)
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Close_box
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))
      "@[<v 2>%s@ %a@]" % string) name pp dir.

Module INDEX.
  Record signature {t : Type} := {
    t := t;
    path_length : Z;
    to_path : t -> list string -> list string;
    of_path : list string -> option t;
    rpc_arg : Tezos_protocol_environment_alpha__Environment.RPC_arg.t t;
    encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t t;
    compare : t -> t -> Z;
  }.
  Arguments signature : clear implicits.
End INDEX.

Reserved Notation "'handler".

Inductive handler_gadt : Type :=
| Handler : forall {a key : Type},
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
  (key ->
    Z ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult a))
  -> handler_gadt

where "'handler" := (fun (_ : Type) => handler_gadt).

Definition handler := 'handler.

Reserved Notation "'opt_handler".

Inductive opt_handler_gadt : Type :=
| Opt_handler : forall {a key : Type},
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
  (key ->
    Z ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option a))) -> opt_handler_gadt

where "'opt_handler" := (fun (_ : Type) => opt_handler_gadt).

Definition opt_handler := 'opt_handler.

Fixpoint combine_object {A : Type}
  (function_parameter : list (string * opt_handler A)) : handler A :=
  match function_parameter with
  | [] =>
    Handler
      {| encoding := Data_encoding.unit;
        get :=
          fun function_parameter =>
            let '_ := function_parameter in
            fun function_parameter =>
              let '_ := function_parameter in
              return_unit |}
  | cons (name, Opt_handler handler) fields =>
    let 'Handler handlers := combine_object fields in
    Handler
      {|
        encoding :=
          Data_encoding.merge_objs
            (obj1 (opt None None name (dynamic_size None (encoding handler))))
            (encoding handlers);
        get :=
          fun k =>
            fun i =>
              op_gtgteqquestion ((get handler) k i)
                (fun v1 =>
                  op_gtgteqquestion ((get handlers) k i)
                    (fun v2 => __return (v1, v2))) |}
  end.

Record query := {
  depth : Z }.

Definition depth_query
  : Tezos_protocol_environment_alpha__Environment.RPC_query.t query :=
  op_pipegt
    (op_pipeplus (query (fun depth => {| depth := depth |}))
      (field None "depth" % string RPC_arg.int 0 (fun t => depth t))) seal.

Definition build_directory {key : Type} (dir : t key)
  : Tezos_protocol_environment_alpha__Environment.RPC_directory.t key :=
  let rpc_dir := ref RPC_directory.empty in
  let register {ikey : Type}
    (path : Tezos_protocol_environment_alpha__Environment.RPC_path.t key ikey)
    (function_parameter : opt_handler ikey) : unit :=
    let 'Opt_handler {| encoding := encoding; get := get |} :=
      function_parameter in
    let service := RPC_service.get_service None depth_query encoding path in
    op_coloneq rpc_dir
      (RPC_directory.register (op_exclamation rpc_dir) service
        (fun k =>
          fun q =>
            fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteqquestion (get k (op_plus (depth q) 1))
                (fun function_parameter =>
                  match function_parameter with
                  | None => raise OCaml.Not_found
                  | Some x => __return x
                  end))) in
  let fix build_handler {ikey : Type}
    (dir : t ikey) (path :
    Tezos_protocol_environment_alpha__Environment.RPC_path.t key ikey)
    : opt_handler ikey :=
    match op_exclamation dir with
    | Empty =>
      Opt_handler
        {| encoding := Data_encoding.unit;
          get :=
            fun function_parameter =>
              let '_ := function_parameter in
              fun function_parameter =>
                let '_ := function_parameter in
                return_none |}
    | Value {| get := get; encoding := encoding |} =>
      let handler :=
        Opt_handler
          {| encoding := encoding;
            get :=
              fun k =>
                fun i =>
                  if
                    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
                      i 0 then
                    return_none
                  else
                    get k |} in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ := register path handler in
      handler
    | NamedDir map =>
      let fields :=
        StringMap.(Tezos_protocol_environment_alpha__Environment.MAP.S.bindings)
          map in
      let fields :=
        List.map
          (fun function_parameter =>
            let '(name, dir) := function_parameter in
            (name, (build_handler dir (op_div path name)))) fields in
      let 'Handler handler := combine_object fields in
      let handler :=
        Opt_handler
          {| encoding := encoding handler;
            get :=
              fun k =>
                fun i =>
                  if
                    Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
                      i 0 then
                    return_none
                  else
                    op_gtgteqquestion ((get handler) k (op_minus i 1))
                      (fun v => return_some v) |} in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ := register path handler in
      handler
    |
      IndexedDir {|
        arg := arg;
          arg_encoding := arg_encoding;
          list := list;
          subdir := subdir
          |} =>
      let 'Opt_handler handler := build_handler subdir (op_divcolon path arg) in
      let encoding :=
        union None
          (cons
            (case "Leaf" % string None
              (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
              (dynamic_size None arg_encoding)
              (fun function_parameter =>
                match function_parameter with
                | (key, None) => Some key
                | _ => None
                end) (fun key => (key, None)))
            (cons
              (case "Dir" % string None
                (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag
                  1)
                (tup2 (dynamic_size None arg_encoding)
                  (dynamic_size None (encoding handler)))
                (fun function_parameter =>
                  match function_parameter with
                  | (key, Some value) => Some (key, value)
                  | _ => None
                  end)
                (fun function_parameter =>
                  let '(key, value) := function_parameter in
                  (key, (Some value)))) [])) in
      let get
        (k : ikey) (i :
        Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
        : Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (option
              (list (op_dollarIndexedDir_'a * option op_dollarOpt_handler_'a1)))) :=
        if
          Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_lt)
            i 0 then
          return_none
        else
          if
            Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
              i 0 then
            return_some []
          else
            op_gtgteqquestion (list k)
              (fun keys =>
                op_gtgteqquestion
                  (map_s
                    (fun key =>
                      if
                        Tezos_protocol_environment_alpha__Environment.Compare.Int.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_eq)
                          i 1 then
                        __return (key, None)
                      else
                        op_gtgteqquestion
                          ((get handler) (k, key) (op_minus i 1))
                          (fun value => __return (key, value))) keys)
                  (fun values => return_some values)) in
      let handler :=
        Opt_handler
          {| encoding := list None (dynamic_size None encoding); get := get |}
        in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ := register path handler in
      handler
    end in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := ignore (build_handler dir RPC_path.open_root) in
  op_exclamation rpc_dir.
storage_description.mli 3 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Typed description of the key-value context. *)
type 'key t

(** Trivial display of the key-value context layout. *)
val pp : Format.formatter -> 'key t -> unit

(** Export an RPC hierarchy for querying the context. There is one service
    by possible path in the context. Services for "directory" are able to
    aggregate in one JSON object the whole subtree. *)
val build_directory : 'key t -> 'key RPC_directory.t

(** Create a empty context description,
    keys will be registred by side effects. *)
val create : unit -> 'key t

(** Register a single key accessor at a given path. *)
val register_value :
  'key t ->
  get:('key -> 'a option tzresult Lwt.t) ->
  'a Data_encoding.t ->
  unit

(** Return a description for a prefixed fragment of the given context.
    All keys registred in the subcontext will be shared by the external
    context *)
val register_named_subcontext : 'key t -> string list -> 'key t

(** Description of an index as a sequence of `RPC_arg.t`. *)
type (_, _, _) args =
  | One : {
      rpc_arg : 'a RPC_arg.t;
      encoding : 'a Data_encoding.t;
      compare : 'a -> 'a -> int;
    }
      -> ('key, 'a, 'key * 'a) args
  | Pair :
      ('key, 'a, 'inter_key) args * ('inter_key, 'b, 'sub_key) args
      -> ('key, 'a * 'b, 'sub_key) args

(** Return a description for a indexed sub-context.
    All keys registred in the subcontext will be shared by the external
    context. One should provide a function to list all the registred
    index in the context. *)
val register_indexed_subcontext :
  'key t ->
  list:('key -> 'arg list tzresult Lwt.t) ->
  ('key, 'arg, 'sub_key) args ->
  'sub_key t

(** Helpers for manipulating and defining indexes. *)

val pack : ('key, 'a, 'sub_key) args -> 'key -> 'a -> 'sub_key

val unpack : ('key, 'a, 'sub_key) args -> 'sub_key -> 'key * 'a

module type INDEX = sig
  type t

  val path_length : int

  val to_path : t -> string list -> string list

  val of_path : string list -> t option

  val rpc_arg : t RPC_arg.t

  val encoding : t Data_encoding.t

  val compare : t -> t -> int
end
storage_description_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter t : forall (key : Type), Type.

Parameter pp : forall {key : Type},
Tezos_protocol_environment_alpha__Environment.Format.formatter -> t key -> unit.

Parameter build_directory : forall {key : Type},
t key -> Tezos_protocol_environment_alpha__Environment.RPC_directory.t key.

Parameter create : forall {key : Type}, unit -> t key.

Parameter register_value : forall {a key : Type},
t key ->
  (key ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (option a))) ->
    Tezos_protocol_environment_alpha__Environment.Data_encoding.t a -> unit.

Parameter register_named_subcontext : forall {key : Type},
t key -> list string -> t key.

Reserved Notation "'args".

Inductive args_gadt : Type :=
| One : forall {a : Type},
  Tezos_protocol_environment_alpha__Environment.RPC_arg.t a ->
  Tezos_protocol_environment_alpha__Environment.Data_encoding.t a ->
  (a -> a -> Z) -> args_gadt
| Pair : args_gadt -> args_gadt -> args_gadt

where "'args" := (fun (_ _ _ : Type) => args_gadt).

Definition args := 'args.

Parameter register_indexed_subcontext : forall {arg key sub_key : Type},
t key ->
  (key ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (list arg))) -> args key arg sub_key -> t sub_key.

Parameter pack : forall {a key sub_key : Type},
args key a sub_key -> key -> a -> sub_key.

Parameter unpack : forall {a key sub_key : Type},
args key a sub_key -> sub_key -> key * a.

module_type
storage_functors.ml 18 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Storage_sigs

module Registered = struct
  let ghost = false
end

module Ghost = struct
  let ghost = true
end

module Make_encoder (V : VALUE) = struct
  let of_bytes ~key b =
    match Data_encoding.Binary.of_bytes V.encoding b with
    | None ->
        error (Raw_context.Storage_error (Corrupted_data key))
    | Some v ->
        Ok v

  let to_bytes v =
    match Data_encoding.Binary.to_bytes V.encoding v with
    | Some b ->
        b
    | None ->
        MBytes.create 0
end

let len_name = "len"

let data_name = "data"

let encode_len_value bytes =
  let length = MBytes.length bytes in
  Data_encoding.(Binary.to_bytes_exn int31) length

let decode_len_value key len =
  match Data_encoding.(Binary.of_bytes int31) len with
  | None ->
      fail (Raw_context.Storage_error (Corrupted_data key))
  | Some len ->
      return len

let map_key f = function `Key k -> `Key (f k) | `Dir k -> `Dir (f k)

module Make_subcontext (R : REGISTER) (C : Raw_context.T) (N : NAME) :
  Raw_context.T with type t = C.t = struct
  type t = C.t

  type context = t

  let name_length = List.length N.name

  let to_key k = N.name @ k

  let of_key k = Misc.remove_elem_from_list name_length k

  let mem t k = C.mem t (to_key k)

  let dir_mem t k = C.dir_mem t (to_key k)

  let get t k = C.get t (to_key k)

  let get_option t k = C.get_option t (to_key k)

  let init t k v = C.init t (to_key k) v

  let set t k v = C.set t (to_key k) v

  let init_set t k v = C.init_set t (to_key k) v

  let set_option t k v = C.set_option t (to_key k) v

  let delete t k = C.delete t (to_key k)

  let remove t k = C.remove t (to_key k)

  let remove_rec t k = C.remove_rec t (to_key k)

  let copy t ~from ~to_ = C.copy t ~from:(to_key from) ~to_:(to_key to_)

  let fold t k ~init ~f =
    C.fold t (to_key k) ~init ~f:(fun k acc -> f (map_key of_key k) acc)

  let keys t k = C.keys t (to_key k) >|= fun keys -> List.map of_key keys

  let fold_keys t k ~init ~f =
    C.fold_keys t (to_key k) ~init ~f:(fun k acc -> f (of_key k) acc)

  let project = C.project

  let absolute_key c k = C.absolute_key c (to_key k)

  let consume_gas = C.consume_gas

  let check_enough_gas = C.check_enough_gas

  let description =
    let description =
      if R.ghost then Storage_description.create () else C.description
    in
    Storage_description.register_named_subcontext description N.name
end

module Make_single_data_storage
    (R : REGISTER)
    (C : Raw_context.T)
    (N : NAME)
    (V : VALUE) : Single_data_storage with type t = C.t and type value = V.t =
struct
  type t = C.t

  type context = t

  type value = V.t

  let mem t = C.mem t N.name

  include Make_encoder (V)

  let get t =
    C.get t N.name
    >>=? fun b ->
    let key = C.absolute_key t N.name in
    Lwt.return (of_bytes ~key b)

  let get_option t =
    C.get_option t N.name
    >>= function
    | None ->
        return_none
    | Some b -> (
        let key = C.absolute_key t N.name in
        match of_bytes ~key b with
        | Ok v ->
            return_some v
        | Error _ as err ->
            Lwt.return err )

  let init t v =
    C.init t N.name (to_bytes v) >>=? fun t -> return (C.project t)

  let set t v = C.set t N.name (to_bytes v) >>=? fun t -> return (C.project t)

  let init_set t v =
    C.init_set t N.name (to_bytes v) >>= fun t -> Lwt.return (C.project t)

  let set_option t v =
    C.set_option t N.name (Option.map ~f:to_bytes v)
    >>= fun t -> Lwt.return (C.project t)

  let remove t = C.remove t N.name >>= fun t -> Lwt.return (C.project t)

  let delete t = C.delete t N.name >>=? fun t -> return (C.project t)

  let () =
    let open Storage_description in
    let description =
      if R.ghost then Storage_description.create () else C.description
    in
    register_value
      ~get:get_option
      (register_named_subcontext description N.name)
      V.encoding
end

module type INDEX = sig
  type t

  val path_length : int

  val to_path : t -> string list -> string list

  val of_path : string list -> t option

  type 'a ipath

  val args : ('a, t, 'a ipath) Storage_description.args
end

module Pair (I1 : INDEX) (I2 : INDEX) : INDEX with type t = I1.t * I2.t =
struct
  type t = I1.t * I2.t

  let path_length = I1.path_length + I2.path_length

  let to_path (x, y) l = I1.to_path x (I2.to_path y l)

  let of_path l =
    match Misc.take I1.path_length l with
    | None ->
        None
    | Some (l1, l2) -> (
      match (I1.of_path l1, I2.of_path l2) with
      | (Some x, Some y) ->
          Some (x, y)
      | _ ->
          None )

  type 'a ipath = 'a I1.ipath I2.ipath

  let args = Storage_description.Pair (I1.args, I2.args)
end

module Make_data_set_storage (C : Raw_context.T) (I : INDEX) :
  Data_set_storage with type t = C.t and type elt = I.t = struct
  type t = C.t

  type context = t

  type elt = I.t

  let inited = MBytes.of_string "inited"

  let mem s i = C.mem s (I.to_path i [])

  let add s i =
    C.init_set s (I.to_path i []) inited >>= fun t -> Lwt.return (C.project t)

  let del s i =
    C.remove s (I.to_path i []) >>= fun t -> Lwt.return (C.project t)

  let set s i = function true -> add s i | false -> del s i

  let clear s = C.remove_rec s [] >>= fun t -> Lwt.return (C.project t)

  let fold s ~init ~f =
    let rec dig i path acc =
      if Compare.Int.(i <= 1) then
        C.fold s path ~init:acc ~f:(fun k acc ->
            match k with
            | `Dir _ ->
                Lwt.return acc
            | `Key file -> (
              match I.of_path file with
              | None ->
                  assert false
              | Some p ->
                  f p acc ))
      else
        C.fold s path ~init:acc ~f:(fun k acc ->
            match k with
            | `Dir k ->
                dig (i - 1) k acc
            | `Key _ ->
                Lwt.return acc)
    in
    dig I.path_length [] init

  let elements s = fold s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))

  let () =
    let open Storage_description in
    let unpack = unpack I.args in
    register_value (* TODO fixme 'elements...' *)
      ~get:(fun c ->
        let (c, k) = unpack c in
        mem c k >>= function true -> return_some true | false -> return_none)
      (register_indexed_subcontext
         ~list:(fun c -> elements c >>= return)
         C.description
         I.args)
      Data_encoding.bool
end

module Make_indexed_data_storage (C : Raw_context.T) (I : INDEX) (V : VALUE) :
  Indexed_data_storage
    with type t = C.t
     and type key = I.t
     and type value = V.t = struct
  type t = C.t

  type context = t

  type key = I.t

  type value = V.t

  include Make_encoder (V)

  let mem s i = C.mem s (I.to_path i [])

  let get s i =
    C.get s (I.to_path i [])
    >>=? fun b ->
    let key = C.absolute_key s (I.to_path i []) in
    Lwt.return (of_bytes ~key b)

  let get_option s i =
    C.get_option s (I.to_path i [])
    >>= function
    | None ->
        return_none
    | Some b -> (
        let key = C.absolute_key s (I.to_path i []) in
        match of_bytes ~key b with
        | Ok v ->
            return_some v
        | Error _ as err ->
            Lwt.return err )

  let set s i v =
    C.set s (I.to_path i []) (to_bytes v) >>=? fun t -> return (C.project t)

  let init s i v =
    C.init s (I.to_path i []) (to_bytes v) >>=? fun t -> return (C.project t)

  let init_set s i v =
    C.init_set s (I.to_path i []) (to_bytes v)
    >>= fun t -> Lwt.return (C.project t)

  let set_option s i v =
    C.set_option s (I.to_path i []) (Option.map ~f:to_bytes v)
    >>= fun t -> Lwt.return (C.project t)

  let remove s i =
    C.remove s (I.to_path i []) >>= fun t -> Lwt.return (C.project t)

  let delete s i =
    C.delete s (I.to_path i []) >>=? fun t -> return (C.project t)

  let clear s = C.remove_rec s [] >>= fun t -> Lwt.return (C.project t)

  let fold_keys s ~init ~f =
    let rec dig i path acc =
      if Compare.Int.(i <= 1) then
        C.fold s path ~init:acc ~f:(fun k acc ->
            match k with
            | `Dir _ ->
                Lwt.return acc
            | `Key file -> (
              match I.of_path file with
              | None ->
                  assert false
              | Some path ->
                  f path acc ))
      else
        C.fold s path ~init:acc ~f:(fun k acc ->
            match k with
            | `Dir k ->
                dig (i - 1) k acc
            | `Key _ ->
                Lwt.return acc)
    in
    dig I.path_length [] init

  let fold s ~init ~f =
    let f path acc =
      get s path
      >>= function
      | Error _ ->
          (* FIXME: silently ignore unparsable data *)
          Lwt.return acc
      | Ok v ->
          f path v acc
    in
    fold_keys s ~init ~f

  let bindings s =
    fold s ~init:[] ~f:(fun p v acc -> Lwt.return ((p, v) :: acc))

  let keys s = fold_keys s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))

  let () =
    let open Storage_description in
    let unpack = unpack I.args in
    register_value
      ~get:(fun c ->
        let (c, k) = unpack c in
        get_option c k)
      (register_indexed_subcontext
         ~list:(fun c -> keys c >>= return)
         C.description
         I.args)
      V.encoding
end

module Make_indexed_carbonated_data_storage
    (C : Raw_context.T)
    (I : INDEX)
    (V : VALUE) :
  Non_iterable_indexed_carbonated_data_storage
    with type t = C.t
     and type key = I.t
     and type value = V.t = struct
  type t = C.t

  type context = t

  type key = I.t

  type value = V.t

  include Make_encoder (V)

  let data_key i = I.to_path i [data_name]

  let len_key i = I.to_path i [len_name]

  let consume_mem_gas c =
    Lwt.return (C.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero))

  let existing_size c i =
    C.get_option c (len_key i)
    >>= function
    | None ->
        return (0, false)
    | Some len ->
        decode_len_value (len_key i) len >>=? fun len -> return (len, true)

  let consume_read_gas get c i =
    get c (len_key i)
    >>=? fun len ->
    decode_len_value (len_key i) len
    >>=? fun len ->
    Lwt.return
      (C.consume_gas c (Gas_limit_repr.read_bytes_cost (Z.of_int len)))

  let consume_serialize_write_gas set c i v =
    let bytes = to_bytes v in
    let len = MBytes.length bytes in
    Lwt.return (C.consume_gas c (Gas_limit_repr.alloc_mbytes_cost len))
    >>=? fun c ->
    Lwt.return
      (C.consume_gas c (Gas_limit_repr.write_bytes_cost (Z.of_int len)))
    >>=? fun c ->
    set c (len_key i) (encode_len_value bytes) >>=? fun c -> return (c, bytes)

  let consume_remove_gas del c i =
    Lwt.return (C.consume_gas c (Gas_limit_repr.write_bytes_cost Z.zero))
    >>=? fun c -> del c (len_key i)

  let mem s i =
    consume_mem_gas s
    >>=? fun s ->
    C.mem s (data_key i) >>= fun exists -> return (C.project s, exists)

  let get s i =
    consume_read_gas C.get s i
    >>=? fun s ->
    C.get s (data_key i)
    >>=? fun b ->
    let key = C.absolute_key s (data_key i) in
    Lwt.return (of_bytes ~key b) >>=? fun v -> return (C.project s, v)

  let get_option s i =
    consume_mem_gas s
    >>=? fun s ->
    C.mem s (data_key i)
    >>= fun exists ->
    if exists then get s i >>=? fun (s, v) -> return (s, Some v)
    else return (C.project s, None)

  let set s i v =
    existing_size s i
    >>=? fun (prev_size, _) ->
    consume_serialize_write_gas C.set s i v
    >>=? fun (s, bytes) ->
    C.set s (data_key i) bytes
    >>=? fun t ->
    let size_diff = MBytes.length bytes - prev_size in
    return (C.project t, size_diff)

  let init s i v =
    consume_serialize_write_gas C.init s i v
    >>=? fun (s, bytes) ->
    C.init s (data_key i) bytes
    >>=? fun t ->
    let size = MBytes.length bytes in
    return (C.project t, size)

  let init_set s i v =
    let init_set s i v = C.init_set s i v >>= return in
    existing_size s i
    >>=? fun (prev_size, existed) ->
    consume_serialize_write_gas init_set s i v
    >>=? fun (s, bytes) ->
    init_set s (data_key i) bytes
    >>=? fun t ->
    let size_diff = MBytes.length bytes - prev_size in
    return (C.project t, size_diff, existed)

  let remove s i =
    let remove s i = C.remove s i >>= return in
    existing_size s i
    >>=? fun (prev_size, existed) ->
    consume_remove_gas remove s i
    >>=? fun s ->
    remove s (data_key i) >>=? fun t -> return (C.project t, prev_size, existed)

  let delete s i =
    existing_size s i
    >>=? fun (prev_size, _) ->
    consume_remove_gas C.delete s i
    >>=? fun s ->
    C.delete s (data_key i) >>=? fun t -> return (C.project t, prev_size)

  let set_option s i v =
    match v with None -> remove s i | Some v -> init_set s i v

  let fold_keys_unaccounted s ~init ~f =
    let rec dig i path acc =
      if Compare.Int.(i <= 0) then
        C.fold s path ~init:acc ~f:(fun k acc ->
            match k with
            | `Dir _ ->
                Lwt.return acc
            | `Key file -> (
              match List.rev file with
              | last :: _ when Compare.String.(last = len_name) ->
                  Lwt.return acc
              | last :: rest when Compare.String.(last = data_name) -> (
                  let file = List.rev rest in
                  match I.of_path file with
                  | None ->
                      assert false
                  | Some path ->
                      f path acc )
              | _ ->
                  assert false ))
      else
        C.fold s path ~init:acc ~f:(fun k acc ->
            match k with
            | `Dir k ->
                dig (i - 1) k acc
            | `Key _ ->
                Lwt.return acc)
    in
    dig I.path_length [] init

  let keys_unaccounted s =
    fold_keys_unaccounted s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))

  let () =
    let open Storage_description in
    let unpack = unpack I.args in
    register_value (* TODO export consumed gas ?? *)
      ~get:(fun c ->
        let (c, k) = unpack c in
        get_option c k >>=? fun (_, v) -> return v)
      (register_indexed_subcontext
         ~list:(fun c -> keys_unaccounted c >>= return)
         C.description
         I.args)
      V.encoding
end

module Make_indexed_data_snapshotable_storage
    (C : Raw_context.T)
    (Snapshot_index : INDEX)
    (I : INDEX)
    (V : VALUE) :
  Indexed_data_snapshotable_storage
    with type t = C.t
     and type snapshot = Snapshot_index.t
     and type key = I.t
     and type value = V.t = struct
  type snapshot = Snapshot_index.t

  let data_name = ["current"]

  let snapshot_name = ["snapshot"]

  module C_data =
    Make_subcontext (Registered) (C)
      (struct
        let name = data_name
      end)

  module C_snapshot =
    Make_subcontext (Registered) (C)
      (struct
        let name = snapshot_name
      end)

  include Make_indexed_data_storage (C_data) (I) (V)
  module Snapshot =
    Make_indexed_data_storage (C_snapshot) (Pair (Snapshot_index) (I)) (V)

  let snapshot_path id = snapshot_name @ Snapshot_index.to_path id []

  let snapshot_exists s id = C.dir_mem s (snapshot_path id)

  let snapshot s id =
    C.copy s ~from:data_name ~to_:(snapshot_path id)
    >>=? fun t -> return (C.project t)

  let delete_snapshot s id =
    C.remove_rec s (snapshot_path id) >>= fun t -> Lwt.return (C.project t)
end

module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) :
  Indexed_raw_context
    with type t = C.t
     and type key = I.t
     and type 'a ipath = 'a I.ipath = struct
  type t = C.t

  type context = t

  type key = I.t

  type 'a ipath = 'a I.ipath

  let clear t = C.remove_rec t [] >>= fun t -> Lwt.return (C.project t)

  let fold_keys t ~init ~f =
    let rec dig i path acc =
      if Compare.Int.(i <= 0) then
        match I.of_path path with
        | None ->
            assert false
        | Some path ->
            f path acc
      else
        C.fold t path ~init:acc ~f:(fun k acc ->
            match k with
            | `Dir k ->
                dig (i - 1) k acc
            | `Key _ ->
                Lwt.return acc)
    in
    dig I.path_length [] init

  let keys t = fold_keys t ~init:[] ~f:(fun i acc -> Lwt.return (i :: acc))

  let list t k = C.fold t k ~init:[] ~f:(fun k acc -> Lwt.return (k :: acc))

  let remove_rec t k = C.remove_rec t (I.to_path k [])

  let copy t ~from ~to_ =
    C.copy t ~from:(I.to_path from []) ~to_:(I.to_path to_ [])

  let description =
    Storage_description.register_indexed_subcontext
      ~list:(fun c -> keys c >>= return)
      C.description
      I.args

  let unpack = Storage_description.unpack I.args

  let pack = Storage_description.pack I.args

  module Raw_context = struct
    type t = C.t I.ipath

    type context = t

    let to_key i k = I.to_path i k

    let of_key k = Misc.remove_elem_from_list I.path_length k

    let mem c k =
      let (t, i) = unpack c in
      C.mem t (to_key i k)

    let dir_mem c k =
      let (t, i) = unpack c in
      C.dir_mem t (to_key i k)

    let get c k =
      let (t, i) = unpack c in
      C.get t (to_key i k)

    let get_option c k =
      let (t, i) = unpack c in
      C.get_option t (to_key i k)

    let init c k v =
      let (t, i) = unpack c in
      C.init t (to_key i k) v >>=? fun t -> return (pack t i)

    let set c k v =
      let (t, i) = unpack c in
      C.set t (to_key i k) v >>=? fun t -> return (pack t i)

    let init_set c k v =
      let (t, i) = unpack c in
      C.init_set t (to_key i k) v >>= fun t -> Lwt.return (pack t i)

    let set_option c k v =
      let (t, i) = unpack c in
      C.set_option t (to_key i k) v >>= fun t -> Lwt.return (pack t i)

    let delete c k =
      let (t, i) = unpack c in
      C.delete t (to_key i k) >>=? fun t -> return (pack t i)

    let remove c k =
      let (t, i) = unpack c in
      C.remove t (to_key i k) >>= fun t -> Lwt.return (pack t i)

    let remove_rec c k =
      let (t, i) = unpack c in
      C.remove_rec t (to_key i k) >>= fun t -> Lwt.return (pack t i)

    let copy c ~from ~to_ =
      let (t, i) = unpack c in
      C.copy t ~from:(to_key i from) ~to_:(to_key i to_)
      >>=? fun t -> return (pack t i)

    let fold c k ~init ~f =
      let (t, i) = unpack c in
      C.fold t (to_key i k) ~init ~f:(fun k acc -> f (map_key of_key k) acc)

    let keys c k =
      let (t, i) = unpack c in
      C.keys t (to_key i k) >|= fun keys -> List.map of_key keys

    let fold_keys c k ~init ~f =
      let (t, i) = unpack c in
      C.fold_keys t (to_key i k) ~init ~f:(fun k acc -> f (of_key k) acc)

    let project c =
      let (t, _) = unpack c in
      C.project t

    let absolute_key c k =
      let (t, i) = unpack c in
      C.absolute_key t (to_key i k)

    let consume_gas c g =
      let (t, i) = unpack c in
      C.consume_gas t g >>? fun t -> ok (pack t i)

    let check_enough_gas c g =
      let (t, _i) = unpack c in
      C.check_enough_gas t g

    let description = description
  end

  let resolve t prefix =
    let rec loop i prefix = function
      | [] when Compare.Int.(i = I.path_length) -> (
        match I.of_path prefix with
        | None ->
            assert false
        | Some path ->
            Lwt.return [path] )
      | [] ->
          list t prefix
          >>= fun prefixes ->
          Lwt_list.map_s
            (function `Key prefix | `Dir prefix -> loop (i + 1) prefix [])
            prefixes
          >|= List.flatten
      | [d] when Compare.Int.(i = I.path_length - 1) ->
          if Compare.Int.(i >= I.path_length) then invalid_arg "IO.resolve" ;
          list t prefix
          >>= fun prefixes ->
          Lwt_list.map_s
            (function
              | `Key prefix | `Dir prefix -> (
                match
                  Misc.remove_prefix ~prefix:d (List.hd (List.rev prefix))
                with
                | None ->
                    Lwt.return_nil
                | Some _ ->
                    loop (i + 1) prefix [] ))
            prefixes
          >|= List.flatten
      | "" :: ds ->
          list t prefix
          >>= fun prefixes ->
          Lwt_list.map_s
            (function `Key prefix | `Dir prefix -> loop (i + 1) prefix ds)
            prefixes
          >|= List.flatten
      | d :: ds -> (
          if Compare.Int.(i >= I.path_length) then invalid_arg "IO.resolve" ;
          C.dir_mem t (prefix @ [d])
          >>= function
          | true -> loop (i + 1) (prefix @ [d]) ds | false -> Lwt.return_nil )
    in
    loop 0 [] prefix

  module Make_set (R : REGISTER) (N : NAME) = struct
    type t = C.t

    type context = t

    type elt = I.t

    let inited = MBytes.of_string "inited"

    let mem s i = Raw_context.mem (pack s i) N.name

    let add s i =
      Raw_context.init_set (pack s i) N.name inited
      >>= fun c ->
      let (s, _) = unpack c in
      Lwt.return (C.project s)

    let del s i =
      Raw_context.remove (pack s i) N.name
      >>= fun c ->
      let (s, _) = unpack c in
      Lwt.return (C.project s)

    let set s i = function true -> add s i | false -> del s i

    let clear s =
      fold_keys s ~init:s ~f:(fun i s ->
          Raw_context.remove (pack s i) N.name
          >>= fun c ->
          let (s, _) = unpack c in
          Lwt.return s)
      >>= fun t -> Lwt.return (C.project t)

    let fold s ~init ~f =
      fold_keys s ~init ~f:(fun i acc ->
          mem s i >>= function true -> f i acc | false -> Lwt.return acc)

    let elements s = fold s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))

    let () =
      let open Storage_description in
      let unpack = unpack I.args in
      let description =
        if R.ghost then Storage_description.create ()
        else Raw_context.description
      in
      register_value
        ~get:(fun c ->
          let (c, k) = unpack c in
          mem c k
          >>= function true -> return_some true | false -> return_none)
        (register_named_subcontext description N.name)
        Data_encoding.bool
  end

  module Make_map (N : NAME) (V : VALUE) = struct
    type t = C.t

    type context = t

    type key = I.t

    type value = V.t

    include Make_encoder (V)

    let mem s i = Raw_context.mem (pack s i) N.name

    let get s i =
      Raw_context.get (pack s i) N.name
      >>=? fun b ->
      let key = Raw_context.absolute_key (pack s i) N.name in
      Lwt.return (of_bytes ~key b)

    let get_option s i =
      Raw_context.get_option (pack s i) N.name
      >>= function
      | None ->
          return_none
      | Some b -> (
          let key = Raw_context.absolute_key (pack s i) N.name in
          match of_bytes ~key b with
          | Ok v ->
              return_some v
          | Error _ as err ->
              Lwt.return err )

    let set s i v =
      Raw_context.set (pack s i) N.name (to_bytes v)
      >>=? fun c ->
      let (s, _) = unpack c in
      return (C.project s)

    let init s i v =
      Raw_context.init (pack s i) N.name (to_bytes v)
      >>=? fun c ->
      let (s, _) = unpack c in
      return (C.project s)

    let init_set s i v =
      Raw_context.init_set (pack s i) N.name (to_bytes v)
      >>= fun c ->
      let (s, _) = unpack c in
      Lwt.return (C.project s)

    let set_option s i v =
      Raw_context.set_option (pack s i) N.name (Option.map ~f:to_bytes v)
      >>= fun c ->
      let (s, _) = unpack c in
      Lwt.return (C.project s)

    let remove s i =
      Raw_context.remove (pack s i) N.name
      >>= fun c ->
      let (s, _) = unpack c in
      Lwt.return (C.project s)

    let delete s i =
      Raw_context.delete (pack s i) N.name
      >>=? fun c ->
      let (s, _) = unpack c in
      return (C.project s)

    let clear s =
      fold_keys s ~init:s ~f:(fun i s ->
          Raw_context.remove (pack s i) N.name
          >>= fun c ->
          let (s, _) = unpack c in
          Lwt.return s)
      >>= fun t -> Lwt.return (C.project t)

    let fold s ~init ~f =
      fold_keys s ~init ~f:(fun i acc ->
          get s i >>= function Error _ -> Lwt.return acc | Ok v -> f i v acc)

    let bindings s =
      fold s ~init:[] ~f:(fun p v acc -> Lwt.return ((p, v) :: acc))

    let fold_keys s ~init ~f =
      fold_keys s ~init ~f:(fun i acc ->
          mem s i >>= function false -> Lwt.return acc | true -> f i acc)

    let keys s = fold_keys s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))

    let () =
      let open Storage_description in
      let unpack = unpack I.args in
      register_value
        ~get:(fun c ->
          let (c, k) = unpack c in
          get_option c k)
        (register_named_subcontext Raw_context.description N.name)
        V.encoding
  end

  module Make_carbonated_map (N : NAME) (V : VALUE) = struct
    type t = C.t

    type context = t

    type key = I.t

    type value = V.t

    include Make_encoder (V)

    let len_name = len_name :: N.name

    let data_name = data_name :: N.name

    let consume_mem_gas c =
      Lwt.return
        (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero))

    let existing_size c =
      Raw_context.get_option c len_name
      >>= function
      | None ->
          return (0, false)
      | Some len ->
          decode_len_value len_name len >>=? fun len -> return (len, true)

    let consume_read_gas get c =
      get c len_name
      >>=? fun len ->
      decode_len_value len_name len
      >>=? fun len ->
      Lwt.return
        (Raw_context.consume_gas
           c
           (Gas_limit_repr.read_bytes_cost (Z.of_int len)))

    let consume_write_gas set c v =
      let bytes = to_bytes v in
      let len = MBytes.length bytes in
      Lwt.return
        (Raw_context.consume_gas
           c
           (Gas_limit_repr.write_bytes_cost (Z.of_int len)))
      >>=? fun c ->
      set c len_name (encode_len_value bytes) >>=? fun c -> return (c, bytes)

    let consume_remove_gas del c =
      Lwt.return
        (Raw_context.consume_gas c (Gas_limit_repr.write_bytes_cost Z.zero))
      >>=? fun c -> del c len_name

    let mem s i =
      consume_mem_gas (pack s i)
      >>=? fun c ->
      Raw_context.mem c data_name
      >>= fun res -> return (Raw_context.project c, res)

    let get s i =
      consume_read_gas Raw_context.get (pack s i)
      >>=? fun c ->
      Raw_context.get c data_name
      >>=? fun b ->
      let key = Raw_context.absolute_key c data_name in
      Lwt.return (of_bytes ~key b)
      >>=? fun v -> return (Raw_context.project c, v)

    let get_option s i =
      consume_mem_gas (pack s i)
      >>=? fun c ->
      let (s, _) = unpack c in
      Raw_context.mem (pack s i) data_name
      >>= fun exists ->
      if exists then get s i >>=? fun (s, v) -> return (s, Some v)
      else return (C.project s, None)

    let set s i v =
      existing_size (pack s i)
      >>=? fun (prev_size, _) ->
      consume_write_gas Raw_context.set (pack s i) v
      >>=? fun (c, bytes) ->
      Raw_context.set c data_name bytes
      >>=? fun c ->
      let size_diff = MBytes.length bytes - prev_size in
      return (Raw_context.project c, size_diff)

    let init s i v =
      consume_write_gas Raw_context.init (pack s i) v
      >>=? fun (c, bytes) ->
      Raw_context.init c data_name bytes
      >>=? fun c ->
      let size = MBytes.length bytes in
      return (Raw_context.project c, size)

    let init_set s i v =
      let init_set c k v = Raw_context.init_set c k v >>= return in
      existing_size (pack s i)
      >>=? fun (prev_size, existed) ->
      consume_write_gas init_set (pack s i) v
      >>=? fun (c, bytes) ->
      init_set c data_name bytes
      >>=? fun c ->
      let size_diff = MBytes.length bytes - prev_size in
      return (Raw_context.project c, size_diff, existed)

    let remove s i =
      let remove c k = Raw_context.remove c k >>= return in
      existing_size (pack s i)
      >>=? fun (prev_size, existed) ->
      consume_remove_gas remove (pack s i)
      >>=? fun c ->
      remove c data_name
      >>=? fun c -> return (Raw_context.project c, prev_size, existed)

    let delete s i =
      existing_size (pack s i)
      >>=? fun (prev_size, _) ->
      consume_remove_gas Raw_context.delete (pack s i)
      >>=? fun c ->
      Raw_context.delete c data_name
      >>=? fun c -> return (Raw_context.project c, prev_size)

    let set_option s i v =
      match v with None -> remove s i | Some v -> init_set s i v

    let () =
      let open Storage_description in
      let unpack = unpack I.args in
      register_value
        ~get:(fun c ->
          let (c, k) = unpack c in
          get_option c k >>=? fun (_, v) -> return v)
        (register_named_subcontext Raw_context.description N.name)
        V.encoding
  end
end

module Wrap_indexed_data_storage
    (C : Indexed_data_storage) (K : sig
      type t

      val wrap : t -> C.key

      val unwrap : C.key -> t option
    end) =
struct
  type t = C.t

  type context = C.t

  type key = K.t

  type value = C.value

  let mem ctxt k = C.mem ctxt (K.wrap k)

  let get ctxt k = C.get ctxt (K.wrap k)

  let get_option ctxt k = C.get_option ctxt (K.wrap k)

  let set ctxt k v = C.set ctxt (K.wrap k) v

  let init ctxt k v = C.init ctxt (K.wrap k) v

  let init_set ctxt k v = C.init_set ctxt (K.wrap k) v

  let set_option ctxt k v = C.set_option ctxt (K.wrap k) v

  let delete ctxt k = C.delete ctxt (K.wrap k)

  let remove ctxt k = C.remove ctxt (K.wrap k)

  let clear ctxt = C.clear ctxt

  let fold ctxt ~init ~f =
    C.fold ctxt ~init ~f:(fun k v acc ->
        match K.unwrap k with None -> Lwt.return acc | Some k -> f k v acc)

  let bindings s =
    fold s ~init:[] ~f:(fun p v acc -> Lwt.return ((p, v) :: acc))

  let fold_keys s ~init ~f =
    C.fold_keys s ~init ~f:(fun k acc ->
        match K.unwrap k with None -> Lwt.return acc | Some k -> f k acc)

  let keys s = fold_keys s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))
end
storage_functors_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Storage_sigs.

Module Registered.
  Definition ghost : bool := false.
End Registered.

Module Ghost.
  Definition ghost : bool := true.
End Ghost.

(* ❌ Functors are not handled. *)
functor

Definition len_name : string := "len" % string.

Definition data_name : string := "data" % string.

Definition encode_len_value
  (bytes : Tezos_protocol_environment_alpha__Environment.MBytes.t)
  : Tezos_protocol_environment_alpha__Environment.MBytes.t :=
  let length := MBytes.length string in
  (Binary.to_bytes_exn int31) length.

Definition decode_len_value
  (key : list string)
  (len : Tezos_protocol_environment_alpha__Environment.MBytes.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z) :=
  match (Binary.of_bytes int31) len with
  | None =>
    fail
      (Tezos_protocol_environment_alpha__Environment.Error_monad.Storage_error
        (Tezos_raw_protocol_alpha.Raw_context.Corrupted_data key))
  | Some len => __return len
  end.

Definition map_key {A B : Type} (f : A -> B) (function_parameter : variant)
  : variant :=
  match function_parameter with
  | Key k =>
    (* ❌ Variants not supported *)
    variant
  | Dir k =>
    (* ❌ Variants not supported *)
    variant
  end.

(* ❌ Functors are not handled. *)
functor

(* ❌ Functors are not handled. *)
functor

Module INDEX.
  Record signature {t ipath : Type} := {
    t := t;
    path_length : Z;
    to_path : t -> list string -> list string;
    of_path : list string -> option t;
    polymorphic_abstract_type;
    args : forall {a : Type}, Tezos_raw_protocol_alpha.Storage_description.args
      a t (ipath a);
  }.
  Arguments signature : clear implicits.
End INDEX.

(* ❌ Functors are not handled. *)
functor

(* ❌ Functors are not handled. *)
functor

(* ❌ Functors are not handled. *)
functor

(* ❌ Functors are not handled. *)
functor

(* ❌ Functors are not handled. *)
functor

(* ❌ Functors are not handled. *)
functor

(* ❌ Functors are not handled. *)
functor
storage_functors.mli 13 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Tezos Protocol Implementation - Typed storage builders. *)

open Storage_sigs

module Registered : REGISTER

module Ghost : REGISTER

module Make_subcontext (R : REGISTER) (C : Raw_context.T) (N : NAME) :
  Raw_context.T with type t = C.t

module Make_single_data_storage
    (R : REGISTER)
    (C : Raw_context.T)
    (N : NAME)
    (V : VALUE) : Single_data_storage with type t = C.t and type value = V.t

module type INDEX = sig
  type t

  val path_length : int

  val to_path : t -> string list -> string list

  val of_path : string list -> t option

  type 'a ipath

  val args : ('a, t, 'a ipath) Storage_description.args
end

module Pair (I1 : INDEX) (I2 : INDEX) : INDEX with type t = I1.t * I2.t

module Make_data_set_storage (C : Raw_context.T) (I : INDEX) :
  Data_set_storage with type t = C.t and type elt = I.t

module Make_indexed_data_storage (C : Raw_context.T) (I : INDEX) (V : VALUE) :
  Indexed_data_storage
    with type t = C.t
     and type key = I.t
     and type value = V.t

module Make_indexed_carbonated_data_storage
    (C : Raw_context.T)
    (I : INDEX)
    (V : VALUE) :
  Non_iterable_indexed_carbonated_data_storage
    with type t = C.t
     and type key = I.t
     and type value = V.t

module Make_indexed_data_snapshotable_storage
    (C : Raw_context.T)
    (Snapshot : INDEX)
    (I : INDEX)
    (V : VALUE) :
  Indexed_data_snapshotable_storage
    with type t = C.t
     and type snapshot = Snapshot.t
     and type key = I.t
     and type value = V.t

module Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) :
  Indexed_raw_context
    with type t = C.t
     and type key = I.t
     and type 'a ipath = 'a I.ipath

module Wrap_indexed_data_storage
    (C : Indexed_data_storage) (K : sig
      type t

      val wrap : t -> C.key

      val unwrap : C.key -> t option
    end) :
  Indexed_data_storage
    with type t = C.t
     and type key = K.t
     and type value = C.value
storage_functors_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

unhandled_module

unhandled_module

unhandled_module

unhandled_module

module_type

unhandled_module

unhandled_module

unhandled_module

unhandled_module

unhandled_module

unhandled_module

unhandled_module
storage_sigs.ml 8 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** {1 Entity Accessor Signatures} *)

(** The generic signature of a single data accessor (a single value
    bound to a specific key in the hierarchical (key x value)
    database). *)
module type Single_data_storage = sig
  type t

  type context = t

  (** The type of the value *)
  type value

  (** Tells if the data is already defined *)
  val mem : context -> bool Lwt.t

  (** Retrieve the value from the storage bucket ; returns a
      {!Storage_error} if the key is not set or if the deserialisation
      fails *)
  val get : context -> value tzresult Lwt.t

  (** Retrieves the value from the storage bucket ; returns [None] if
      the data is not initialized, or {!Storage_helpers.Storage_error}
      if the deserialisation fails *)
  val get_option : context -> value option tzresult Lwt.t

  (** Allocates the storage bucket and initializes it ; returns a
      {!Storage_error Existing_key} if the bucket exists *)
  val init : context -> value -> Raw_context.t tzresult Lwt.t

  (** Updates the content of the bucket ; returns a {!Storage_Error
      Missing_key} if the value does not exists *)
  val set : context -> value -> Raw_context.t tzresult Lwt.t

  (** Allocates the data and initializes it with a value ; just
      updates it if the bucket exists *)
  val init_set : context -> value -> Raw_context.t Lwt.t

  (** When the value is [Some v], allocates the data and initializes
      it with [v] ; just updates it if the bucket exists. When the
      valus is [None], delete the storage bucket when the value ; does
      nothing if the bucket does not exists. *)
  val set_option : context -> value option -> Raw_context.t Lwt.t

  (** Delete the storage bucket ; returns a {!Storage_error
      Missing_key} if the bucket does not exists *)
  val delete : context -> Raw_context.t tzresult Lwt.t

  (** Removes the storage bucket and its contents ; does nothing if
      the bucket does not exists *)
  val remove : context -> Raw_context.t Lwt.t
end

(** Variant of {!Single_data_storage} with gas accounting. *)
module type Single_carbonated_data_storage = sig
  type t

  type context = t

  (** The type of the value *)
  type value

  (** Tells if the data is already defined.
      Consumes [Gas_repr.read_bytes_cost Z.zero]. *)
  val mem : context -> (Raw_context.t * bool) tzresult Lwt.t

  (** Retrieve the value from the storage bucket ; returns a
      {!Storage_error} if the key is not set or if the deserialisation
      fails.
      Consumes [Gas_repr.read_bytes_cost <size of the value>]. *)
  val get : context -> (Raw_context.t * value) tzresult Lwt.t

  (** Retrieves the value from the storage bucket ; returns [None] if
      the data is not initialized, or {!Storage_helpers.Storage_error}
      if the deserialisation fails.
      Consumes [Gas_repr.read_bytes_cost <size of the value>] if present
      or [Gas_repr.read_bytes_cost Z.zero]. *)
  val get_option : context -> (Raw_context.t * value option) tzresult Lwt.t

  (** Allocates the storage bucket and initializes it ; returns a
      {!Storage_error Missing_key} if the bucket exists.
      Consumes [Gas_repr.write_bytes_cost <size of the value>].
      Returns the size. *)
  val init : context -> value -> (Raw_context.t * int) tzresult Lwt.t

  (** Updates the content of the bucket ; returns a {!Storage_Error
      Existing_key} if the value does not exists.
      Consumes [Gas_repr.write_bytes_cost <size of the new value>].
      Returns the difference from the old to the new size. *)
  val set : context -> value -> (Raw_context.t * int) tzresult Lwt.t

  (** Allocates the data and initializes it with a value ; just
      updates it if the bucket exists.
      Consumes [Gas_repr.write_bytes_cost <size of the new value>].
      Returns the difference from the old (maybe 0) to the new size, and a boolean
      indicating if a value was already associated to this key. *)
  val init_set :
    context -> value -> (Raw_context.t * int * bool) tzresult Lwt.t

  (** When the value is [Some v], allocates the data and initializes
      it with [v] ; just updates it if the bucket exists. When the
      valus is [None], delete the storage bucket when the value ; does
      nothing if the bucket does not exists.
      Consumes the same gas cost as either {!remove} or {!init_set}.
      Returns the difference from the old (maybe 0) to the new size, and a boolean
      indicating if a value was already associated to this key. *)
  val set_option :
    context -> value option -> (Raw_context.t * int * bool) tzresult Lwt.t

  (** Delete the storage bucket ; returns a {!Storage_error
      Missing_key} if the bucket does not exists.
      Consumes [Gas_repr.write_bytes_cost Z.zero].
      Returns the freed size. *)
  val delete : context -> (Raw_context.t * int) tzresult Lwt.t

  (** Removes the storage bucket and its contents ; does nothing if
      the bucket does not exists.
      Consumes [Gas_repr.write_bytes_cost Z.zero].
      Returns the freed size, and a boolean
      indicating if a value was already associated to this key. *)
  val remove : context -> (Raw_context.t * int * bool) tzresult Lwt.t
end

(** Restricted version of {!Indexed_data_storage} w/o iterators. *)
module type Non_iterable_indexed_data_storage = sig
  type t

  type context = t

  (** An abstract type for keys *)
  type key

  (** The type of values *)
  type value

  (** Tells if a given key is already bound to a storage bucket *)
  val mem : context -> key -> bool Lwt.t

  (** Retrieve a value from the storage bucket at a given key ;
      returns {!Storage_error Missing_key} if the key is not set ;
      returns {!Storage_error Corrupted_data} if the deserialisation
      fails. *)
  val get : context -> key -> value tzresult Lwt.t

  (** Retrieve a value from the storage bucket at a given key ;
      returns [None] if the value is not set ; returns {!Storage_error
      Corrupted_data} if the deserialisation fails. *)
  val get_option : context -> key -> value option tzresult Lwt.t

  (** Updates the content of a bucket ; returns A {!Storage_Error
      Missing_key} if the value does not exists. *)
  val set : context -> key -> value -> Raw_context.t tzresult Lwt.t

  (** Allocates a storage bucket at the given key and initializes it ;
      returns a {!Storage_error Existing_key} if the bucket exists. *)
  val init : context -> key -> value -> Raw_context.t tzresult Lwt.t

  (** Allocates a storage bucket at the given key and initializes it
      with a value ; just updates it if the bucket exists. *)
  val init_set : context -> key -> value -> Raw_context.t Lwt.t

  (** When the value is [Some v], allocates the data and initializes
      it with [v] ; just updates it if the bucket exists. When the
      valus is [None], delete the storage bucket when the value ; does
      nothing if the bucket does not exists. *)
  val set_option : context -> key -> value option -> Raw_context.t Lwt.t

  (** Delete a storage bucket and its contents ; returns a
      {!Storage_error Missing_key} if the bucket does not exists. *)
  val delete : context -> key -> Raw_context.t tzresult Lwt.t

  (** Removes a storage bucket and its contents ; does nothing if the
      bucket does not exists. *)
  val remove : context -> key -> Raw_context.t Lwt.t
end

(** Variant of {!Non_iterable_indexed_data_storage} with gas accounting. *)
module type Non_iterable_indexed_carbonated_data_storage = sig
  type t

  type context = t

  (** An abstract type for keys *)
  type key

  (** The type of values *)
  type value

  (** Tells if a given key is already bound to a storage bucket.
      Consumes [Gas_repr.read_bytes_cost Z.zero]. *)
  val mem : context -> key -> (Raw_context.t * bool) tzresult Lwt.t

  (** Retrieve a value from the storage bucket at a given key ;
      returns {!Storage_error Missing_key} if the key is not set ;
      returns {!Storage_error Corrupted_data} if the deserialisation
      fails.
      Consumes [Gas_repr.read_bytes_cost <size of the value>]. *)
  val get : context -> key -> (Raw_context.t * value) tzresult Lwt.t

  (** Retrieve a value from the storage bucket at a given key ;
      returns [None] if the value is not set ; returns {!Storage_error
      Corrupted_data} if the deserialisation fails.
      Consumes [Gas_repr.read_bytes_cost <size of the value>] if present
      or [Gas_repr.read_bytes_cost Z.zero]. *)
  val get_option :
    context -> key -> (Raw_context.t * value option) tzresult Lwt.t

  (** Updates the content of a bucket ; returns A {!Storage_Error
      Missing_key} if the value does not exists.
      Consumes serialization cost.
      Consumes [Gas_repr.write_bytes_cost <size of the new value>].
      Returns the difference from the old to the new size. *)
  val set : context -> key -> value -> (Raw_context.t * int) tzresult Lwt.t

  (** Allocates a storage bucket at the given key and initializes it ;
      returns a {!Storage_error Existing_key} if the bucket exists.
      Consumes serialization cost.
      Consumes [Gas_repr.write_bytes_cost <size of the value>].
      Returns the size. *)
  val init : context -> key -> value -> (Raw_context.t * int) tzresult Lwt.t

  (** Allocates a storage bucket at the given key and initializes it
      with a value ; just updates it if the bucket exists.
      Consumes serialization cost.
      Consumes [Gas_repr.write_bytes_cost <size of the new value>].
      Returns the difference from the old (maybe 0) to the new size, and a boolean
      indicating if a value was already associated to this key. *)
  val init_set :
    context -> key -> value -> (Raw_context.t * int * bool) tzresult Lwt.t

  (** When the value is [Some v], allocates the data and initializes
      it with [v] ; just updates it if the bucket exists. When the
      valus is [None], delete the storage bucket when the value ; does
      nothing if the bucket does not exists.
      Consumes serialization cost.
      Consumes the same gas cost as either {!remove} or {!init_set}.
      Returns the difference from the old (maybe 0) to the new size, and a boolean
      indicating if a value was already associated to this key. *)
  val set_option :
    context ->
    key ->
    value option ->
    (Raw_context.t * int * bool) tzresult Lwt.t

  (** Delete a storage bucket and its contents ; returns a
      {!Storage_error Missing_key} if the bucket does not exists.
      Consumes [Gas_repr.write_bytes_cost Z.zero].
      Returns the freed size. *)
  val delete : context -> key -> (Raw_context.t * int) tzresult Lwt.t

  (** Removes a storage bucket and its contents ; does nothing if the
      bucket does not exists.
      Consumes [Gas_repr.write_bytes_cost Z.zero].
      Returns the freed size, and a boolean
      indicating if a value was already associated to this key. *)
  val remove : context -> key -> (Raw_context.t * int * bool) tzresult Lwt.t
end

(** The generic signature of indexed data accessors (a set of values
    of the same type indexed by keys of the same form in the
    hierarchical (key x value) database). *)
module type Indexed_data_storage = sig
  include Non_iterable_indexed_data_storage

  (** Empties all the keys and associated data. *)
  val clear : context -> Raw_context.t Lwt.t

  (** Lists all the keys. *)
  val keys : context -> key list Lwt.t

  (** Lists all the keys and associated data. *)
  val bindings : context -> (key * value) list Lwt.t

  (** Iterates over all the keys and associated data. *)
  val fold :
    context -> init:'a -> f:(key -> value -> 'a -> 'a Lwt.t) -> 'a Lwt.t

  (** Iterate over all the keys. *)
  val fold_keys : context -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t
end

module type Indexed_data_snapshotable_storage = sig
  type snapshot

  type key

  include Indexed_data_storage with type key := key

  module Snapshot :
    Indexed_data_storage
      with type key = snapshot * key
       and type value = value
       and type t = t

  val snapshot_exists : context -> snapshot -> bool Lwt.t

  val snapshot : context -> snapshot -> Raw_context.t tzresult Lwt.t

  val delete_snapshot : context -> snapshot -> Raw_context.t Lwt.t
end

(** The generic signature of a data set accessor (a set of values
    bound to a specific key prefix in the hierarchical (key x value)
    database). *)
module type Data_set_storage = sig
  type t

  type context = t

  (** The type of elements. *)
  type elt

  (** Tells if a elt is a member of the set *)
  val mem : context -> elt -> bool Lwt.t

  (** Adds a elt is a member of the set *)
  val add : context -> elt -> Raw_context.t Lwt.t

  (** Removes a elt of the set ; does nothing if not a member *)
  val del : context -> elt -> Raw_context.t Lwt.t

  (** Adds/Removes a elt of the set *)
  val set : context -> elt -> bool -> Raw_context.t Lwt.t

  (** Returns the elements of the set, deserialized in a list in no
      particular order. *)
  val elements : context -> elt list Lwt.t

  (** Iterates over the elements of the set. *)
  val fold : context -> init:'a -> f:(elt -> 'a -> 'a Lwt.t) -> 'a Lwt.t

  (** Removes all elements in the set *)
  val clear : context -> Raw_context.t Lwt.t
end

module type NAME = sig
  val name : Raw_context.key
end

module type VALUE = sig
  type t

  val encoding : t Data_encoding.t
end

module type REGISTER = sig
  val ghost : bool
end

module type Indexed_raw_context = sig
  type t

  type context = t

  type key

  type 'a ipath

  val clear : context -> Raw_context.t Lwt.t

  val fold_keys : context -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t

  val keys : context -> key list Lwt.t

  val resolve : context -> string list -> key list Lwt.t

  val remove_rec : context -> key -> context Lwt.t

  val copy : context -> from:key -> to_:key -> context tzresult Lwt.t

  module Make_set (R : REGISTER) (N : NAME) :
    Data_set_storage with type t = t and type elt = key

  module Make_map (N : NAME) (V : VALUE) :
    Indexed_data_storage
      with type t = t
       and type key = key
       and type value = V.t

  module Make_carbonated_map (N : NAME) (V : VALUE) :
    Non_iterable_indexed_carbonated_data_storage
      with type t = t
       and type key = key
       and type value = V.t

  module Raw_context : Raw_context.T with type t = t ipath
end
storage_sigs_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Module Single_data_storage.
  Record signature {t value : Type} := {
    t := t;
    context := t;
    value := value;
    mem : context -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool;
    get : context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          value);
    get_option : context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (option value));
    init : context ->
      value ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Raw_context.t);
    set : context ->
      value ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Raw_context.t);
    init_set : context ->
      value ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          Tezos_raw_protocol_alpha.Raw_context.t;
    set_option : context ->
      option value ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          Tezos_raw_protocol_alpha.Raw_context.t;
    delete : context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t);
    remove : context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
  }.
  Arguments signature : clear implicits.
End Single_data_storage.

Module Single_carbonated_data_storage.
  Record signature {t value : Type} := {
    t := t;
    context := t;
    value := value;
    mem : context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * bool));
    get : context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * value));
    get_option : context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * option value));
    init : context ->
      value ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (Tezos_raw_protocol_alpha.Raw_context.t * Z));
    set : context ->
      value ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (Tezos_raw_protocol_alpha.Raw_context.t * Z));
    init_set : context ->
      value ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool));
    set_option : context ->
      option value ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool));
    delete : context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z));
    remove : context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool));
  }.
  Arguments signature : clear implicits.
End Single_carbonated_data_storage.

Module Non_iterable_indexed_data_storage.
  Record signature {t key value : Type} := {
    t := t;
    context := t;
    key := key;
    value := value;
    mem : context ->
      key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool;
    get : context ->
      key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            value);
    get_option : context ->
      key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (option value));
    set : context ->
      key ->
        value ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              Tezos_raw_protocol_alpha.Raw_context.t);
    init : context ->
      key ->
        value ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              Tezos_raw_protocol_alpha.Raw_context.t);
    init_set : context ->
      key ->
        value ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            Tezos_raw_protocol_alpha.Raw_context.t;
    set_option : context ->
      key ->
        option value ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            Tezos_raw_protocol_alpha.Raw_context.t;
    delete : context ->
      key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Raw_context.t);
    remove : context ->
      key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          Tezos_raw_protocol_alpha.Raw_context.t;
  }.
  Arguments signature : clear implicits.
End Non_iterable_indexed_data_storage.

Module Non_iterable_indexed_carbonated_data_storage.
  Record signature {t key value : Type} := {
    t := t;
    context := t;
    key := key;
    value := value;
    mem : context ->
      key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (Tezos_raw_protocol_alpha.Raw_context.t * bool));
    get : context ->
      key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (Tezos_raw_protocol_alpha.Raw_context.t * value));
    get_option : context ->
      key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (Tezos_raw_protocol_alpha.Raw_context.t * option value));
    set : context ->
      key ->
        value ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (Tezos_raw_protocol_alpha.Raw_context.t * Z));
    init : context ->
      key ->
        value ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (Tezos_raw_protocol_alpha.Raw_context.t * Z));
    init_set : context ->
      key ->
        value ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool));
    set_option : context ->
      key ->
        option value ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool));
    delete : context ->
      key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (Tezos_raw_protocol_alpha.Raw_context.t * Z));
    remove : context ->
      key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (Tezos_raw_protocol_alpha.Raw_context.t * Z * bool));
  }.
  Arguments signature : clear implicits.
End Non_iterable_indexed_carbonated_data_storage.

Module Indexed_data_storage.
  Record signature {t key value : Type} := {
    t := t;
    context := t;
    key := key;
    value := value;
    mem : context ->
      key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool;
    get : context ->
      key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            value);
    get_option : context ->
      key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (option value));
    set : context ->
      key ->
        value ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              Tezos_raw_protocol_alpha.Raw_context.t);
    init : context ->
      key ->
        value ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              Tezos_raw_protocol_alpha.Raw_context.t);
    init_set : context ->
      key ->
        value ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            Tezos_raw_protocol_alpha.Raw_context.t;
    set_option : context ->
      key ->
        option value ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            Tezos_raw_protocol_alpha.Raw_context.t;
    delete : context ->
      key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Raw_context.t);
    remove : context ->
      key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          Tezos_raw_protocol_alpha.Raw_context.t;
    clear : context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
    keys : context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list key);
    bindings : context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value));
    fold : forall {a : Type}, context ->
      a ->
        (key ->
          value -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a)
          -> Tezos_protocol_environment_alpha__Environment.Lwt.t a;
    fold_keys : forall {a : Type}, context ->
      a ->
        (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t a;
  }.
  Arguments signature : clear implicits.
End Indexed_data_storage.

Module Indexed_data_snapshotable_storage.
  Record signature {snapshot key t value : Type} := {
    snapshot := snapshot;
    key := key;
    t := t;
    context := t;
    value := value;
    mem : context ->
      key -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool;
    get : context ->
      key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            value);
    get_option : context ->
      key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            (option value));
    set : context ->
      key ->
        value ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              Tezos_raw_protocol_alpha.Raw_context.t);
    init : context ->
      key ->
        value ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              Tezos_raw_protocol_alpha.Raw_context.t);
    init_set : context ->
      key ->
        value ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            Tezos_raw_protocol_alpha.Raw_context.t;
    set_option : context ->
      key ->
        option value ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            Tezos_raw_protocol_alpha.Raw_context.t;
    delete : context ->
      key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Raw_context.t);
    remove : context ->
      key ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          Tezos_raw_protocol_alpha.Raw_context.t;
    clear : context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
    keys : context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list key);
    bindings : context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list (key * value));
    fold : forall {a : Type}, context ->
      a ->
        (key ->
          value -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a)
          -> Tezos_protocol_environment_alpha__Environment.Lwt.t a;
    fold_keys : forall {a : Type}, context ->
      a ->
        (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t a;
    Snapshot : Indexed_data_storage.signature t (snapshot * key) value;
    snapshot_exists : context ->
      snapshot -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool;
    snapshot : context ->
      snapshot ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Raw_context.t);
    delete_snapshot : context ->
      snapshot ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          Tezos_raw_protocol_alpha.Raw_context.t;
  }.
  Arguments signature : clear implicits.
End Indexed_data_snapshotable_storage.

Module Data_set_storage.
  Record signature {t elt : Type} := {
    t := t;
    context := t;
    elt := elt;
    mem : context ->
      elt -> Tezos_protocol_environment_alpha__Environment.Lwt.t bool;
    add : context ->
      elt ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          Tezos_raw_protocol_alpha.Raw_context.t;
    del : context ->
      elt ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          Tezos_raw_protocol_alpha.Raw_context.t;
    set : context ->
      elt ->
        bool ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            Tezos_raw_protocol_alpha.Raw_context.t;
    elements : context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list elt);
    fold : forall {a : Type}, context ->
      a ->
        (elt -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t a;
    clear : context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
  }.
  Arguments signature : clear implicits.
End Data_set_storage.

Module NAME.
  Record signature := {
    name : Tezos_raw_protocol_alpha.Raw_context.key;
  }.
End NAME.

Module VALUE.
  Record signature {t : Type} := {
    t := t;
    encoding : Tezos_protocol_environment_alpha__Environment.Data_encoding.t t;
  }.
  Arguments signature : clear implicits.
End VALUE.

Module REGISTER.
  Record signature := {
    ghost : bool;
  }.
End REGISTER.

Module Indexed_raw_context.
  Record signature {t key ipath : Type} := {
    t := t;
    context := t;
    key := key;
    polymorphic_abstract_type;
    clear : context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        Tezos_raw_protocol_alpha.Raw_context.t;
    fold_keys : forall {a : Type}, context ->
      a ->
        (key -> a -> Tezos_protocol_environment_alpha__Environment.Lwt.t a) ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t a;
    keys : context ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t (list key);
    resolve : context ->
      list string ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t (list key);
    remove_rec : context ->
      key -> Tezos_protocol_environment_alpha__Environment.Lwt.t context;
    copy : context ->
      key ->
        key ->
          Tezos_protocol_environment_alpha__Environment.Lwt.t
            (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
              context);
    Make_set : functor;
    Make_map : functor;
    Make_carbonated_map : functor;
    Raw_context : Raw_context.T.signature (ipath t);
  }.
  Arguments signature : clear implicits.
End Indexed_raw_context.
test/activation.ml 117 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** The activation operation creates an implicit contract from a
    registered commitment present in the context. It is parametrized by
    a public key hash (pkh) and a secret.

    The commitments are composed of :
    - a blinded pkh that can be revealed by the secret ;
    - an amount.

    The commitments and the secrets are generated from
    /scripts/create_genesis/create_genenis.py and should be coherent.
*)

open Protocol
open Alpha_context
open Test_utils
open Test_tez

(* Generated commitments and secrets  *)

(* Commitments are hard-coded in {Tezos_proto_alpha_parameters.Default_parameters} *)

(* let commitments =
 *   List.map (fun (bpkh, a) ->
 *       Commitment_repr.{
 *         blinded_public_key_hash=Blinded_public_key_hash.of_b58check_exn bpkh ;
 *         amount = Tez_repr.of_mutez_exn (Int64.of_string a)}
 *     )
 *     [ ( "btz1bRL4X5BWo2Fj4EsBdUwexXqgTf75uf1qa", "23932454669343" ) ;
 *       ( "btz1SxjV1syBgftgKy721czKi3arVkVwYUFSv", "72954577464032" ) ;
 *       ( "btz1LtoNCjiW23txBTenALaf5H6NKF1L3c1gw", "217487035428349" ) ;
 *       ( "btz1SUd3mMhEBcWudrn8u361MVAec4WYCcFoy", "4092742372031" ) ;
 *       ( "btz1MvBXf4orko1tsGmzkjLbpYSgnwUjEe81r", "17590039016550" ) ;
 *       ( "btz1LoDZ3zsjgG3k3cqTpUMc9bsXbchu9qMXT", "26322312350555" ) ;
 *       ( "btz1RMfq456hFV5AeDiZcQuZhoMv2dMpb9hpP", "244951387881443" ) ;
 *       ( "btz1Y9roTh4A7PsMBkp8AgdVFrqUDNaBE59y1", "80065050465525" ) ;
 *       ( "btz1Q1N2ePwhVw5ED3aaRVek6EBzYs1GDkSVD", "3569618927693" ) ;
 *       ( "btz1VFFVsVMYHd5WfaDTAt92BeQYGK8Ri4eLy", "9034781424478" ) ;
 *     ] *)

type secret_account = {
  account : public_key_hash;
  activation_code : Blinded_public_key_hash.activation_code;
  amount : Tez.t;
}

let secrets () =
  (* Exported from proto_alpha client - TODO : remove when relocated to lib_crypto *)
  let read_key mnemonic email password =
    match Bip39.of_words mnemonic with
    | None ->
        assert false
    | Some t ->
        (* TODO: unicode normalization (NFKD)... *)
        let passphrase =
          Bigstring.(concat "" [of_string email; of_string password])
        in
        let sk = Bip39.to_seed ~passphrase t in
        let sk = Bigstring.sub_bytes sk 0 32 in
        let sk : Signature.Secret_key.t =
          Ed25519
            (Data_encoding.Binary.of_bytes_exn Ed25519.Secret_key.encoding sk)
        in
        let pk = Signature.Secret_key.to_public_key sk in
        let pkh = Signature.Public_key.hash pk in
        (pkh, pk, sk)
  in
  List.map
    (fun (mnemonic, secret, amount, pkh, password, email) ->
      let (pkh', pk, sk) = read_key mnemonic email password in
      let pkh = Signature.Public_key_hash.of_b58check_exn pkh in
      assert (Signature.Public_key_hash.equal pkh pkh') ;
      let account = Account.{pkh; pk; sk} in
      Account.add_account account ;
      {
        account = account.pkh;
        activation_code = Blinded_public_key_hash.activation_code_of_hex secret;
        amount =
          Option.unopt_exn
            (Invalid_argument "tez conversion")
            (Tez.of_mutez (Int64.of_string amount));
      })
    [ ( [ "envelope";
          "hospital";
          "mind";
          "sunset";
          "cancel";
          "muscle";
          "leisure";
          "thumb";
          "wine";
          "market";
          "exit";
          "lucky";
          "style";
          "picnic";
          "success" ],
        "0f39ed0b656509c2ecec4771712d9cddefe2afac",
        "23932454669343",
        "tz1MawerETND6bqJqx8GV3YHUrvMBCDasRBF",
        "z0eZHQQGKt",
        "cjgfoqmk.wpxnvnup@tezos.example.org" );
      ( [ "flag";
          "quote";
          "will";
          "valley";
          "mouse";
          "chat";
          "hold";
          "prosper";
          "silk";
          "tent";
          "cruel";
          "cause";
          "demise";
          "bottom";
          "practice" ],
        "41f98b15efc63fa893d61d7d6eee4a2ce9427ac4",
        "72954577464032",
        "tz1X4maqF9tC1Yn4jULjHRAyzjAtc25Z68TX",
        "MHErskWPE6",
        "oklmcktr.ztljnpzc@tezos.example.org" );
      ( [ "library";
          "away";
          "inside";
          "paper";
          "wise";
          "focus";
          "sweet";
          "expose";
          "require";
          "change";
          "stove";
          "planet";
          "zone";
          "reflect";
          "finger" ],
        "411dfef031eeecc506de71c9df9f8e44297cf5ba",
        "217487035428348",
        "tz1SWBY7rWMutEuWS54Pt33MkzAS6eWkUuTc",
        "0AO6BzQNfN",
        "ctgnkvqm.kvtiybky@tezos.example.org" );
      ( [ "cruel";
          "fluid";
          "damage";
          "demand";
          "mimic";
          "above";
          "village";
          "alpha";
          "vendor";
          "staff";
          "absent";
          "uniform";
          "fire";
          "asthma";
          "milk" ],
        "08d7d355bc3391d12d140780b39717d9f46fcf87",
        "4092742372031",
        "tz1amUjiZaevaxQy5wKn4SSRvVoERCip3nZS",
        "9kbZ7fR6im",
        "bnyxxzqr.tdszcvqb@tezos.example.org" );
      ( [ "opera";
          "divorce";
          "easy";
          "myself";
          "idea";
          "aim";
          "dash";
          "scout";
          "case";
          "resource";
          "vote";
          "humor";
          "ticket";
          "client";
          "edge" ],
        "9b7cad042fba557618bdc4b62837c5f125b50e56",
        "17590039016550",
        "tz1Zaee3QBtD4ErY1SzqUvyYTrENrExu6yQM",
        "suxT5H09yY",
        "iilkhohu.otnyuvna@tezos.example.org" );
      ( [ "token";
          "similar";
          "ginger";
          "tongue";
          "gun";
          "sort";
          "piano";
          "month";
          "hotel";
          "vote";
          "undo";
          "success";
          "hobby";
          "shell";
          "cart" ],
        "124c0ca217f11ffc6c7b76a743d867c8932e5afd",
        "26322312350555",
        "tz1geDUUhfXK1EMj7VQdRjug1MoFe6gHWnCU",
        "4odVdLykaa",
        "kwhlglvr.slriitzy@tezos.example.org" );
      ( [ "shield";
          "warrior";
          "gorilla";
          "birth";
          "steak";
          "neither";
          "feel";
          "only";
          "liberty";
          "float";
          "oven";
          "extend";
          "pulse";
          "suffer";
          "vapor" ],
        "ac7a2125beea68caf5266a647f24dce9fea018a7",
        "244951387881443",
        "tz1h3nY7jcZciJgAwRhWcrEwqfVp7VQoffur",
        "A6yeMqBFG8",
        "lvrmlbyj.yczltcxn@tezos.example.org" );
      ( [ "waste";
          "open";
          "scan";
          "tip";
          "subway";
          "dance";
          "rent";
          "copper";
          "garlic";
          "laundry";
          "defense";
          "clerk";
          "another";
          "staff";
          "liar" ],
        "2b3e94be133a960fa0ef87f6c0922c19f9d87ca2",
        "80065050465525",
        "tz1VzL4Xrb3fL3ckvqCWy6bdGMzU2w9eoRqs",
        "oVZqpq60sk",
        "rfodmrha.zzdndvyk@tezos.example.org" );
      ( [ "fiber";
          "next";
          "property";
          "cradle";
          "silk";
          "obey";
          "gossip";
          "push";
          "key";
          "second";
          "across";
          "minimum";
          "nice";
          "boil";
          "age" ],
        "dac31640199f2babc157aadc0021cd71128ca9ea",
        "3569618927693",
        "tz1RUHg536oRKhPLFfttcB5gSWAhh4E9TWjX",
        "FfytQTTVbu",
        "owecikdy.gxnyttya@tezos.example.org" );
      ( [ "print";
          "labor";
          "budget";
          "speak";
          "poem";
          "diet";
          "chunk";
          "eternal";
          "book";
          "saddle";
          "pioneer";
          "ankle";
          "happy";
          "only";
          "exclude" ],
        "bb841227f250a066eb8429e56937ad504d7b34dd",
        "9034781424478",
        "tz1M1LFbgctcPWxstrao9aLr2ECW1fV4pH5u",
        "zknAl3lrX2",
        "ettilrvh.zsrqrbud@tezos.example.org" ) ]

let activation_init () =
  Context.init ~with_commitments:true 1
  >>=? fun (b, cs) -> secrets () |> fun ss -> return (b, cs, ss)

let simple_init_with_commitments () =
  activation_init ()
  >>=? fun (blk, _contracts, _secrets) ->
  Block.bake blk >>=? fun _ -> return_unit

(** A single activation *)
let single_activation () =
  activation_init ()
  >>=? fun (blk, _contracts, secrets) ->
  let ({account; activation_code; amount = expected_amount; _} as _first_one) =
    List.hd secrets
  in
  (* Contract does not exist *)
  Assert.balance_is
    ~loc:__LOC__
    (B blk)
    (Contract.implicit_contract account)
    Tez.zero
  >>=? fun () ->
  Op.activation (B blk) account activation_code
  >>=? fun operation ->
  Block.bake ~operation blk
  >>=? fun blk ->
  (* Contract does exist *)
  Assert.balance_is
    ~loc:__LOC__
    (B blk)
    (Contract.implicit_contract account)
    expected_amount

(** 10 activations, one per bake *)
let multi_activation_1 () =
  activation_init ()
  >>=? fun (blk, _contracts, secrets) ->
  Error_monad.fold_left_s
    (fun blk {account; activation_code; amount = expected_amount; _} ->
      Op.activation (B blk) account activation_code
      >>=? fun operation ->
      Block.bake ~operation blk
      >>=? fun blk ->
      Assert.balance_is
        ~loc:__LOC__
        (B blk)
        (Contract.implicit_contract account)
        expected_amount
      >>=? fun () -> return blk)
    blk
    secrets
  >>=? fun _ -> return_unit

(** All in one bake *)
let multi_activation_2 () =
  activation_init ()
  >>=? fun (blk, _contracts, secrets) ->
  Error_monad.fold_left_s
    (fun ops {account; activation_code; _} ->
      Op.activation (B blk) account activation_code
      >>=? fun op -> return (op :: ops))
    []
    secrets
  >>=? fun ops ->
  Block.bake ~operations:ops blk
  >>=? fun blk ->
  Error_monad.iter_s
    (fun {account; amount = expected_amount; _} ->
      (* Contract does exist *)
      Assert.balance_is
        ~loc:__LOC__
        (B blk)
        (Contract.implicit_contract account)
        expected_amount)
    secrets

(** Transfer with activated account *)
let activation_and_transfer () =
  activation_init ()
  >>=? fun (blk, contracts, secrets) ->
  let ({account; activation_code; _} as _first_one) = List.hd secrets in
  let bootstrap_contract = List.hd contracts in
  let first_contract = Contract.implicit_contract account in
  Op.activation (B blk) account activation_code
  >>=? fun operation ->
  Block.bake ~operation blk
  >>=? fun blk ->
  Context.Contract.balance (B blk) bootstrap_contract
  >>=? fun amount ->
  Tez.( /? ) amount 2L
  >>?= fun half_amount ->
  Context.Contract.balance (B blk) first_contract
  >>=? fun activated_amount_before ->
  Op.transaction (B blk) bootstrap_contract first_contract half_amount
  >>=? fun operation ->
  Block.bake ~operation blk
  >>=? fun blk ->
  Assert.balance_was_credited
    ~loc:__LOC__
    (B blk)
    (Contract.implicit_contract account)
    activated_amount_before
    half_amount

(** Transfer to an unactivated account and then activating it *)
let transfer_to_unactivated_then_activate () =
  activation_init ()
  >>=? fun (blk, contracts, secrets) ->
  let ({account; activation_code; amount} as _first_one) = List.hd secrets in
  let bootstrap_contract = List.hd contracts in
  let unactivated_commitment_contract = Contract.implicit_contract account in
  Context.Contract.balance (B blk) bootstrap_contract
  >>=? fun b_amount ->
  Tez.( /? ) b_amount 2L
  >>?= fun b_half_amount ->
  Incremental.begin_construction blk
  >>=? fun inc ->
  Op.transaction
    (I inc)
    bootstrap_contract
    unactivated_commitment_contract
    b_half_amount
  >>=? fun op ->
  Incremental.add_operation inc op
  >>=? fun inc ->
  Op.activation (I inc) account activation_code
  >>=? fun op' ->
  Incremental.add_operation inc op'
  >>=? fun inc ->
  Incremental.finalize_block inc
  >>=? fun blk2 ->
  Assert.balance_was_credited
    ~loc:__LOC__
    (B blk2)
    (Contract.implicit_contract account)
    amount
    b_half_amount

(****************************************************************)
(*  The following test scenarios are supposed to raise errors.  *)
(****************************************************************)

(** Invalid pkh activation : expected to fail as the context does not
    contain any commitment *)
let invalid_activation_with_no_commitments () =
  Context.init 1
  >>=? fun (blk, _) ->
  let secrets = secrets () in
  let ({account; activation_code; _} as _first_one) = List.hd secrets in
  Op.activation (B blk) account activation_code
  >>=? fun operation ->
  Block.bake ~operation blk
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Apply.Invalid_activation _ ->
          true
      | _ ->
          false)

(** Wrong activation : wrong secret given in the operation *)
let invalid_activation_wrong_secret () =
  activation_init ()
  >>=? fun (blk, _, secrets) ->
  let ({account; _} as _first_one) = List.nth secrets 0 in
  let ({activation_code; _} as _second_one) = List.nth secrets 1 in
  Op.activation (B blk) account activation_code
  >>=? fun operation ->
  Block.bake ~operation blk
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Apply.Invalid_activation _ ->
          true
      | _ ->
          false)

(** Invalid pkh activation : expected to fail as the context does not
    contain an associated commitment *)
let invalid_activation_inexistent_pkh () =
  activation_init ()
  >>=? fun (blk, _, secrets) ->
  let ({activation_code; _} as _first_one) = List.hd secrets in
  let inexistent_pkh =
    Signature.Public_key_hash.of_b58check_exn
      "tz1PeQHGKPWSpNoozvxgqLN9TFsj6rDqNV3o"
  in
  Op.activation (B blk) inexistent_pkh activation_code
  >>=? fun operation ->
  Block.bake ~operation blk
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Apply.Invalid_activation _ ->
          true
      | _ ->
          false)

(** Invalid pkh activation : expected to fail as the commitment has
    already been claimed *)
let invalid_double_activation () =
  activation_init ()
  >>=? fun (blk, _, secrets) ->
  let ({account; activation_code; _} as _first_one) = List.hd secrets in
  Incremental.begin_construction blk
  >>=? fun inc ->
  Op.activation (I inc) account activation_code
  >>=? fun op ->
  Incremental.add_operation inc op
  >>=? fun inc ->
  Op.activation (I inc) account activation_code
  >>=? fun op' ->
  Incremental.add_operation inc op'
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Apply.Invalid_activation _ ->
          true
      | _ ->
          false)

(** Transfer from an unactivated commitment account *)
let invalid_transfer_from_unactived_account () =
  activation_init ()
  >>=? fun (blk, contracts, secrets) ->
  let ({account; _} as _first_one) = List.hd secrets in
  let bootstrap_contract = List.hd contracts in
  let unactivated_commitment_contract = Contract.implicit_contract account in
  (* No activation *)
  Op.transaction
    (B blk)
    unactivated_commitment_contract
    bootstrap_contract
    Tez.one
  >>=? fun operation ->
  Block.bake ~operation blk
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Contract_storage.Empty_implicit_contract pkh ->
          if pkh = account then true else false
      | _ ->
          false)

let tests =
  [ Test.tztest "init with commitments" `Quick simple_init_with_commitments;
    Test.tztest "single activation" `Quick single_activation;
    Test.tztest "multi-activation one-by-one" `Quick multi_activation_1;
    Test.tztest "multi-activation all at a time" `Quick multi_activation_2;
    Test.tztest "activation and transfer" `Quick activation_and_transfer;
    Test.tztest
      "transfer to unactivated account then activate"
      `Quick
      transfer_to_unactivated_then_activate;
    Test.tztest
      "invalid activation with no commitments"
      `Quick
      invalid_activation_with_no_commitments;
    Test.tztest
      "invalid activation with commitments"
      `Quick
      invalid_activation_inexistent_pkh;
    Test.tztest "invalid double activation" `Quick invalid_double_activation;
    Test.tztest "wrong activation code" `Quick invalid_activation_wrong_secret;
    Test.tztest
      "invalid transfer from unactivated account"
      `Quick
      invalid_transfer_from_unactived_account ]
activation_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Protocol.

Import Alpha_context.

Record secret_account := {
  account : Tezos_protocol_alpha.Protocol.Alpha_context.public_key_hash;
  activation_code :
    Tezos_protocol_alpha.Protocol.Blinded_public_key_hash.activation_code;
  amount : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.t }.

Definition secrets (function_parameter : unit) : list secret_account :=
  let 'tt := function_parameter in
  let read_key {A : Type}
    (mnemonic : list string) (email : string) (password : string)
    : Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
      * A * Stdlib.Bytes.t :=
    match op_startypeminuserrorstar mnemonic with
    | None =>
      (* ❌ Assert instruction is not handled. *)
      assert false
    | Some t =>
      let passphrase :=
        concat "" % string
          (cons (of_string email) (cons (of_string password) [])) in
      let sk := op_startypeminuserrorstar passphrase t in
      let sk := Bigstring.sub_bytes sk 0 32 in
      let '_ := op_startypeminuserrorstar in
      let pk := op_startypeminuserrorstar sk in
      let pkh := Signature.Public_key.hash pk in
      (pkh, pk, sk)
    end in
  List.map
    (fun function_parameter =>
      let '(mnemonic, secret, amount, pkh, password, email) :=
        function_parameter in
      let '(pkh', pk, sk) := read_key mnemonic email password in
      let pkh := Signature.Public_key_hash.of_b58check_exn pkh in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ :=
        (* ❌ Assert instruction is not handled. *)
        assert (Signature.Public_key_hash.equal pkh pkh') in
      let account := op_startypeminuserrorstar in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ := op_startypeminuserrorstar account in
      {| account := pkh account;
        activation_code := Blinded_public_key_hash.activation_code_of_hex secret;
        amount :=
          op_startypeminuserrorstar
            (OCaml.Invalid_argument "tez conversion" % string)
            (Tez.of_mutez (Int64.of_string amount)) |})
    (cons
      ((cons "envelope" % string
        (cons "hospital" % string
          (cons "mind" % string
            (cons "sunset" % string
              (cons "cancel" % string
                (cons "muscle" % string
                  (cons "leisure" % string
                    (cons "thumb" % string
                      (cons "wine" % string
                        (cons "market" % string
                          (cons "exit" % string
                            (cons "lucky" % string
                              (cons "style" % string
                                (cons "picnic" % string
                                  (cons "success" % string []))))))))))))))),
        "0f39ed0b656509c2ecec4771712d9cddefe2afac" % string,
        "23932454669343" % string,
        "tz1MawerETND6bqJqx8GV3YHUrvMBCDasRBF" % string, "z0eZHQQGKt" % string,
        "cjgfoqmk.wpxnvnup@tezos.example.org" % string)
      (cons
        ((cons "flag" % string
          (cons "quote" % string
            (cons "will" % string
              (cons "valley" % string
                (cons "mouse" % string
                  (cons "chat" % string
                    (cons "hold" % string
                      (cons "prosper" % string
                        (cons "silk" % string
                          (cons "tent" % string
                            (cons "cruel" % string
                              (cons "cause" % string
                                (cons "demise" % string
                                  (cons "bottom" % string
                                    (cons "practice" % string []))))))))))))))),
          "41f98b15efc63fa893d61d7d6eee4a2ce9427ac4" % string,
          "72954577464032" % string,
          "tz1X4maqF9tC1Yn4jULjHRAyzjAtc25Z68TX" % string,
          "MHErskWPE6" % string, "oklmcktr.ztljnpzc@tezos.example.org" % string)
        (cons
          ((cons "library" % string
            (cons "away" % string
              (cons "inside" % string
                (cons "paper" % string
                  (cons "wise" % string
                    (cons "focus" % string
                      (cons "sweet" % string
                        (cons "expose" % string
                          (cons "require" % string
                            (cons "change" % string
                              (cons "stove" % string
                                (cons "planet" % string
                                  (cons "zone" % string
                                    (cons "reflect" % string
                                      (cons "finger" % string []))))))))))))))),
            "411dfef031eeecc506de71c9df9f8e44297cf5ba" % string,
            "217487035428348" % string,
            "tz1SWBY7rWMutEuWS54Pt33MkzAS6eWkUuTc" % string,
            "0AO6BzQNfN" % string,
            "ctgnkvqm.kvtiybky@tezos.example.org" % string)
          (cons
            ((cons "cruel" % string
              (cons "fluid" % string
                (cons "damage" % string
                  (cons "demand" % string
                    (cons "mimic" % string
                      (cons "above" % string
                        (cons "village" % string
                          (cons "alpha" % string
                            (cons "vendor" % string
                              (cons "staff" % string
                                (cons "absent" % string
                                  (cons "uniform" % string
                                    (cons "fire" % string
                                      (cons "asthma" % string
                                        (cons "milk" % string []))))))))))))))),
              "08d7d355bc3391d12d140780b39717d9f46fcf87" % string,
              "4092742372031" % string,
              "tz1amUjiZaevaxQy5wKn4SSRvVoERCip3nZS" % string,
              "9kbZ7fR6im" % string,
              "bnyxxzqr.tdszcvqb@tezos.example.org" % string)
            (cons
              ((cons "opera" % string
                (cons "divorce" % string
                  (cons "easy" % string
                    (cons "myself" % string
                      (cons "idea" % string
                        (cons "aim" % string
                          (cons "dash" % string
                            (cons "scout" % string
                              (cons "case" % string
                                (cons "resource" % string
                                  (cons "vote" % string
                                    (cons "humor" % string
                                      (cons "ticket" % string
                                        (cons "client" % string
                                          (cons "edge" % string []))))))))))))))),
                "9b7cad042fba557618bdc4b62837c5f125b50e56" % string,
                "17590039016550" % string,
                "tz1Zaee3QBtD4ErY1SzqUvyYTrENrExu6yQM" % string,
                "suxT5H09yY" % string,
                "iilkhohu.otnyuvna@tezos.example.org" % string)
              (cons
                ((cons "token" % string
                  (cons "similar" % string
                    (cons "ginger" % string
                      (cons "tongue" % string
                        (cons "gun" % string
                          (cons "sort" % string
                            (cons "piano" % string
                              (cons "month" % string
                                (cons "hotel" % string
                                  (cons "vote" % string
                                    (cons "undo" % string
                                      (cons "success" % string
                                        (cons "hobby" % string
                                          (cons "shell" % string
                                            (cons "cart" % string []))))))))))))))),
                  "124c0ca217f11ffc6c7b76a743d867c8932e5afd" % string,
                  "26322312350555" % string,
                  "tz1geDUUhfXK1EMj7VQdRjug1MoFe6gHWnCU" % string,
                  "4odVdLykaa" % string,
                  "kwhlglvr.slriitzy@tezos.example.org" % string)
                (cons
                  ((cons "shield" % string
                    (cons "warrior" % string
                      (cons "gorilla" % string
                        (cons "birth" % string
                          (cons "steak" % string
                            (cons "neither" % string
                              (cons "feel" % string
                                (cons "only" % string
                                  (cons "liberty" % string
                                    (cons "float" % string
                                      (cons "oven" % string
                                        (cons "extend" % string
                                          (cons "pulse" % string
                                            (cons "suffer" % string
                                              (cons "vapor" % string []))))))))))))))),
                    "ac7a2125beea68caf5266a647f24dce9fea018a7" % string,
                    "244951387881443" % string,
                    "tz1h3nY7jcZciJgAwRhWcrEwqfVp7VQoffur" % string,
                    "A6yeMqBFG8" % string,
                    "lvrmlbyj.yczltcxn@tezos.example.org" % string)
                  (cons
                    ((cons "waste" % string
                      (cons "open" % string
                        (cons "scan" % string
                          (cons "tip" % string
                            (cons "subway" % string
                              (cons "dance" % string
                                (cons "rent" % string
                                  (cons "copper" % string
                                    (cons "garlic" % string
                                      (cons "laundry" % string
                                        (cons "defense" % string
                                          (cons "clerk" % string
                                            (cons "another" % string
                                              (cons "staff" % string
                                                (cons "liar" % string []))))))))))))))),
                      "2b3e94be133a960fa0ef87f6c0922c19f9d87ca2" % string,
                      "80065050465525" % string,
                      "tz1VzL4Xrb3fL3ckvqCWy6bdGMzU2w9eoRqs" % string,
                      "oVZqpq60sk" % string,
                      "rfodmrha.zzdndvyk@tezos.example.org" % string)
                    (cons
                      ((cons "fiber" % string
                        (cons "next" % string
                          (cons "property" % string
                            (cons "cradle" % string
                              (cons "silk" % string
                                (cons "obey" % string
                                  (cons "gossip" % string
                                    (cons "push" % string
                                      (cons "key" % string
                                        (cons "second" % string
                                          (cons "across" % string
                                            (cons "minimum" % string
                                              (cons "nice" % string
                                                (cons "boil" % string
                                                  (cons "age" % string []))))))))))))))),
                        "dac31640199f2babc157aadc0021cd71128ca9ea" % string,
                        "3569618927693" % string,
                        "tz1RUHg536oRKhPLFfttcB5gSWAhh4E9TWjX" % string,
                        "FfytQTTVbu" % string,
                        "owecikdy.gxnyttya@tezos.example.org" % string)
                      (cons
                        ((cons "print" % string
                          (cons "labor" % string
                            (cons "budget" % string
                              (cons "speak" % string
                                (cons "poem" % string
                                  (cons "diet" % string
                                    (cons "chunk" % string
                                      (cons "eternal" % string
                                        (cons "book" % string
                                          (cons "saddle" % string
                                            (cons "pioneer" % string
                                              (cons "ankle" % string
                                                (cons "happy" % string
                                                  (cons "only" % string
                                                    (cons "exclude" % string []))))))))))))))),
                          "bb841227f250a066eb8429e56937ad504d7b34dd" % string,
                          "9034781424478" % string,
                          "tz1M1LFbgctcPWxstrao9aLr2ECW1fV4pH5u" % string,
                          "zknAl3lrX2" % string,
                          "ettilrvh.zsrqrbud@tezos.example.org" % string) [])))))))))).

Definition activation_init {A B : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (A * B * list secret_account)) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar true 1)
    (fun function_parameter =>
      let '(b, cs) := function_parameter in
      op_pipegt (secrets tt) (fun ss => __return (b, cs, ss))).

Definition simple_init_with_commitments (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (activation_init tt)
    (fun function_parameter =>
      let '(blk, _contracts, _secrets) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar blk)
        (fun function_parameter =>
          let '_ := function_parameter in
          return_unit)).

Definition single_activation {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (activation_init tt)
    (fun function_parameter =>
      let '(blk, _contracts, secrets) := function_parameter in
      let
        '{|
          account := account;
            activation_code := activation_code;
            amount := expected_amount
            |} as _first_one := List.hd secrets in
      op_gtgteqquestion
        (op_startypeminuserrorstar __LOC__ op_startypeminuserrorstar
          (Contract.implicit_contract account) Tez.zero)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar account
              activation_code)
            (fun operation =>
              op_gtgteqquestion (op_startypeminuserrorstar operation blk)
                (fun blk =>
                  op_startypeminuserrorstar __LOC__ op_startypeminuserrorstar
                    (Contract.implicit_contract account) expected_amount)))).

Definition multi_activation_1 (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (activation_init tt)
    (fun function_parameter =>
      let '(blk, _contracts, secrets) := function_parameter in
      op_gtgteqquestion
        (Error_monad.fold_left_s
          (fun blk =>
            fun function_parameter =>
              let '{|
                account := account;
                  activation_code := activation_code;
                  amount := expected_amount
                  |} := function_parameter in
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar account
                  activation_code)
                (fun operation =>
                  op_gtgteqquestion (op_startypeminuserrorstar operation blk)
                    (fun blk =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar __LOC__
                          op_startypeminuserrorstar
                          (Contract.implicit_contract account) expected_amount)
                        (fun function_parameter =>
                          let 'tt := function_parameter in
                          __return blk)))) blk secrets)
        (fun function_parameter =>
          let '_ := function_parameter in
          return_unit)).

Definition multi_activation_2 (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (activation_init tt)
    (fun function_parameter =>
      let '(blk, _contracts, secrets) := function_parameter in
      op_gtgteqquestion
        (Error_monad.fold_left_s
          (fun ops =>
            fun function_parameter =>
              let '{|
                account := account; activation_code := activation_code |} :=
                function_parameter in
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar account
                  activation_code) (fun op => __return (cons op ops))) []
          secrets)
        (fun ops =>
          op_gtgteqquestion (op_startypeminuserrorstar ops blk)
            (fun blk =>
              Error_monad.iter_s
                (fun function_parameter =>
                  let '{| account := account; amount := expected_amount |} :=
                    function_parameter in
                  op_startypeminuserrorstar __LOC__ op_startypeminuserrorstar
                    (Contract.implicit_contract account) expected_amount)
                secrets))).

Definition activation_and_transfer {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (activation_init tt)
    (fun function_parameter =>
      let '(blk, contracts, secrets) := function_parameter in
      let
        '{| account := account; activation_code := activation_code |} as
          _first_one := List.hd secrets in
      let bootstrap_contract := List.hd contracts in
      let first_contract := Contract.implicit_contract account in
      op_gtgteqquestion
        (op_startypeminuserrorstar op_startypeminuserrorstar account
          activation_code)
        (fun operation =>
          op_gtgteqquestion (op_startypeminuserrorstar operation blk)
            (fun blk =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar
                  bootstrap_contract)
                (fun amount =>
                  op_startypeminuserrorstar
                    (Tez.op_divquestion amount
                      (* ❌ Constant of type int64 is converted to int *)
                      2)
                    (fun half_amount =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          first_contract)
                        (fun activated_amount_before =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar op_startypeminuserrorstar
                              bootstrap_contract first_contract half_amount)
                            (fun operation =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar operation blk)
                                (fun blk =>
                                  op_startypeminuserrorstar __LOC__
                                    op_startypeminuserrorstar
                                    (Contract.implicit_contract account)
                                    activated_amount_before half_amount)))))))).

Definition transfer_to_unactivated_then_activate {A : Type}
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (activation_init tt)
    (fun function_parameter =>
      let '(blk, contracts, secrets) := function_parameter in
      let
        '{|
          account := account;
            activation_code := activation_code;
            amount := amount
            |} as _first_one := List.hd secrets in
      let bootstrap_contract := List.hd contracts in
      let unactivated_commitment_contract := Contract.implicit_contract account
        in
      op_gtgteqquestion
        (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap_contract)
        (fun b_amount =>
          op_startypeminuserrorstar
            (Tez.op_divquestion b_amount
              (* ❌ Constant of type int64 is converted to int *)
              2)
            (fun b_half_amount =>
              op_gtgteqquestion (op_startypeminuserrorstar blk)
                (fun inc =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      bootstrap_contract unactivated_commitment_contract
                      b_half_amount)
                    (fun op =>
                      op_gtgteqquestion (op_startypeminuserrorstar inc op)
                        (fun inc =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar op_startypeminuserrorstar
                              account activation_code)
                            (fun op' =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar inc op')
                                (fun inc =>
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar inc)
                                    (fun blk2 =>
                                      op_startypeminuserrorstar __LOC__
                                        op_startypeminuserrorstar
                                        (Contract.implicit_contract account)
                                        amount b_half_amount))))))))).

Definition invalid_activation_with_no_commitments {A : Type}
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(blk, _) := function_parameter in
      let secrets := secrets tt in
      let
        '{| account := account; activation_code := activation_code |} as
          _first_one := List.hd secrets in
      op_gtgteqquestion
        (op_startypeminuserrorstar op_startypeminuserrorstar account
          activation_code)
        (fun operation =>
          op_gtgteq (op_startypeminuserrorstar operation blk)
            (fun res =>
              op_startypeminuserrorstar __LOC__ res
                (fun function_parameter =>
                  match function_parameter with
                  |
                    Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_activation
                      _ => true
                  | _ => false
                  end)))).

Definition invalid_activation_wrong_secret {A : Type}
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (activation_init tt)
    (fun function_parameter =>
      let '(blk, _, secrets) := function_parameter in
      let '{| account := account |} as _first_one :=
        op_startypeminuserrorstar secrets 0 in
      let '{| activation_code := activation_code |} as _second_one :=
        op_startypeminuserrorstar secrets 1 in
      op_gtgteqquestion
        (op_startypeminuserrorstar op_startypeminuserrorstar account
          activation_code)
        (fun operation =>
          op_gtgteq (op_startypeminuserrorstar operation blk)
            (fun res =>
              op_startypeminuserrorstar __LOC__ res
                (fun function_parameter =>
                  match function_parameter with
                  |
                    Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_activation
                      _ => true
                  | _ => false
                  end)))).

Definition invalid_activation_inexistent_pkh {A : Type}
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (activation_init tt)
    (fun function_parameter =>
      let '(blk, _, secrets) := function_parameter in
      let '{| activation_code := activation_code |} as _first_one :=
        List.hd secrets in
      let inexistent_pkh :=
        Signature.Public_key_hash.of_b58check_exn
          "tz1PeQHGKPWSpNoozvxgqLN9TFsj6rDqNV3o" % string in
      op_gtgteqquestion
        (op_startypeminuserrorstar op_startypeminuserrorstar inexistent_pkh
          activation_code)
        (fun operation =>
          op_gtgteq (op_startypeminuserrorstar operation blk)
            (fun res =>
              op_startypeminuserrorstar __LOC__ res
                (fun function_parameter =>
                  match function_parameter with
                  |
                    Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_activation
                      _ => true
                  | _ => false
                  end)))).

Definition invalid_double_activation {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (activation_init tt)
    (fun function_parameter =>
      let '(blk, _, secrets) := function_parameter in
      let
        '{| account := account; activation_code := activation_code |} as
          _first_one := List.hd secrets in
      op_gtgteqquestion (op_startypeminuserrorstar blk)
        (fun inc =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar account
              activation_code)
            (fun op =>
              op_gtgteqquestion (op_startypeminuserrorstar inc op)
                (fun inc =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar account
                      activation_code)
                    (fun op' =>
                      op_gtgteq (op_startypeminuserrorstar inc op')
                        (fun res =>
                          op_startypeminuserrorstar __LOC__ res
                            (fun function_parameter =>
                              match function_parameter with
                              |
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_activation
                                  _ => true
                              | _ => false
                              end))))))).

Definition invalid_transfer_from_unactived_account {A : Type}
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (activation_init tt)
    (fun function_parameter =>
      let '(blk, contracts, secrets) := function_parameter in
      let '{| account := account |} as _first_one := List.hd secrets in
      let bootstrap_contract := List.hd contracts in
      let unactivated_commitment_contract := Contract.implicit_contract account
        in
      op_gtgteqquestion
        (op_startypeminuserrorstar op_startypeminuserrorstar
          unactivated_commitment_contract bootstrap_contract Tez.one)
        (fun operation =>
          op_gtgteq (op_startypeminuserrorstar operation blk)
            (fun res =>
              op_startypeminuserrorstar __LOC__ res
                (fun function_parameter =>
                  match function_parameter with
                  |
                    Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_implicit_contract
                      pkh =>
                    if op_startypeminuserrorstar pkh account then
                      true
                    else
                      false
                  | _ => false
                  end)))).

Definition tests {A : Type} : list A :=
  cons
    (op_startypeminuserrorstar "init with commitments" % string
      (* ❌ Variants not supported *)
      variant simple_init_with_commitments)
    (cons
      (op_startypeminuserrorstar "single activation" % string
        (* ❌ Variants not supported *)
        variant single_activation)
      (cons
        (op_startypeminuserrorstar "multi-activation one-by-one" % string
          (* ❌ Variants not supported *)
          variant multi_activation_1)
        (cons
          (op_startypeminuserrorstar "multi-activation all at a time" % string
            (* ❌ Variants not supported *)
            variant multi_activation_2)
          (cons
            (op_startypeminuserrorstar "activation and transfer" % string
              (* ❌ Variants not supported *)
              variant activation_and_transfer)
            (cons
              (op_startypeminuserrorstar
                "transfer to unactivated account then activate" % string
                (* ❌ Variants not supported *)
                variant transfer_to_unactivated_then_activate)
              (cons
                (op_startypeminuserrorstar
                  "invalid activation with no commitments" % string
                  (* ❌ Variants not supported *)
                  variant invalid_activation_with_no_commitments)
                (cons
                  (op_startypeminuserrorstar
                    "invalid activation with commitments" % string
                    (* ❌ Variants not supported *)
                    variant invalid_activation_inexistent_pkh)
                  (cons
                    (op_startypeminuserrorstar
                      "invalid double activation" % string
                      (* ❌ Variants not supported *)
                      variant invalid_double_activation)
                    (cons
                      (op_startypeminuserrorstar
                        "wrong activation code" % string
                        (* ❌ Variants not supported *)
                        variant invalid_activation_wrong_secret)
                      (cons
                        (op_startypeminuserrorstar
                          "invalid transfer from unactivated account" % string
                          (* ❌ Variants not supported *)
                          variant invalid_transfer_from_unactived_account) [])))))))))).
test/baking.ml 50 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol
open Alpha_context
open Test_utils

(** Tests for [bake_n] and [bake_until_end_cycle]. *)
let test_cycle () =
  Context.init 5
  >>=? fun (b, _) ->
  Context.get_constants (B b)
  >>=? fun csts ->
  let blocks_per_cycle = csts.parametric.blocks_per_cycle in
  let pp fmt x = Format.fprintf fmt "%ld" x in
  (* Tests that [bake_until_cycle_end] returns a block at
     level [blocks_per_cycle]. *)
  Block.bake b
  >>=? fun b ->
  Block.bake_until_cycle_end b
  >>=? fun b ->
  Context.get_level (B b)
  >>=? fun curr_level ->
  Assert.equal
    ~loc:__LOC__
    Int32.equal
    "not the right level"
    pp
    (Alpha_context.Raw_level.to_int32 curr_level)
    blocks_per_cycle
  >>=? fun () ->
  (* Tests that [bake_n n] bakes [n] blocks. *)
  Context.get_level (B b)
  >>=? fun l ->
  Block.bake_n 10 b
  >>=? fun b ->
  Context.get_level (B b)
  >>=? fun curr_level ->
  Assert.equal
    ~loc:__LOC__
    Int32.equal
    "not the right level"
    pp
    (Alpha_context.Raw_level.to_int32 curr_level)
    (Int32.add (Alpha_context.Raw_level.to_int32 l) 10l)

(** Tests the formula introduced in Emmy+ for block reward:
    (16/(p+1)) * (0.8 + 0.2 * e / 32)
    where p is the block priority and
    e is the number of included endorsements *)
let test_block_reward priority () =
  ( match priority with
  | 0 ->
      Test_tez.Tez.(of_int 128 /? Int64.of_int 10)
      >>?= fun min -> return (Test_tez.Tez.of_int 16, min)
  | 1 ->
      Test_tez.Tez.(of_int 64 /? Int64.of_int 10)
      >>?= fun min -> return (Test_tez.Tez.of_int 8, min)
  | 3 ->
      Test_tez.Tez.(of_int 32 /? Int64.of_int 10)
      >>?= fun min -> return (Test_tez.Tez.of_int 4, min)
  | _ ->
      fail (invalid_arg "prio should be 0, 1, or 3") )
  >>=? fun (expected_reward_max_endo, expected_reward_min_endo) ->
  let endorsers_per_block = 32 in
  Context.init ~endorsers_per_block 32
  >>=? fun (b, _) ->
  Context.get_endorsers (B b)
  >>=? fun endorsers ->
  fold_left_s
    (fun ops (endorser : Alpha_services.Delegate.Endorsing_rights.t) ->
      let delegate = endorser.delegate in
      Op.endorsement ~delegate (B b) ()
      >>=? fun op -> return (Operation.pack op :: ops))
    []
    endorsers
  >>=? fun ops ->
  Block.bake ~policy:(By_priority 0) ~operations:ops b
  >>=? fun b ->
  (* bake a block at priority 0 and 32 endorsements;
     the reward is 16 tez *)
  Context.get_baking_reward (B b) ~priority ~endorsing_power:32
  >>=? fun baking_reward ->
  Assert.equal_tez ~loc:__LOC__ baking_reward expected_reward_max_endo
  >>=? fun () ->
  (* bake a block at priority 0 and 0 endorsements;
     the reward is 12.8 tez *)
  Context.get_baking_reward (B b) ~priority ~endorsing_power:0
  >>=? fun baking_reward ->
  Assert.equal_tez ~loc:__LOC__ baking_reward expected_reward_min_endo

let tests =
  [ Test.tztest "cycle" `Quick test_cycle;
    Test.tztest "block_reward for priority 0" `Quick (test_block_reward 0);
    Test.tztest "block_reward for priority 1" `Quick (test_block_reward 1);
    Test.tztest "block_reward for priority 3" `Quick (test_block_reward 3) ]
baking_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Protocol.

Import Alpha_context.

Definition test_cycle {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 5)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
        (fun csts =>
          let blocks_per_cycle := blocks_per_cycle (parametric csts) in
          let pp
            (fmt :
            Tezos_protocol_environment_alpha__Environment.Format.formatter) (x :
            int32) : unit :=
            Format.fprintf fmt
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "%ld" % string) x in
          op_gtgteqquestion (op_startypeminuserrorstar b)
            (fun b =>
              op_gtgteqquestion (op_startypeminuserrorstar b)
                (fun b =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar)
                    (fun curr_level =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar __LOC__ Int32.equal
                          "not the right level" % string pp
                          (Alpha_context.Raw_level.to_int32 curr_level)
                          blocks_per_cycle)
                        (fun function_parameter =>
                          let 'tt := function_parameter in
                          op_gtgteqquestion
                            (op_startypeminuserrorstar op_startypeminuserrorstar)
                            (fun l =>
                              op_gtgteqquestion (op_startypeminuserrorstar 10 b)
                                (fun b =>
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar
                                      op_startypeminuserrorstar)
                                    (fun curr_level =>
                                      op_startypeminuserrorstar __LOC__
                                        Int32.equal
                                        "not the right level" % string pp
                                        (Alpha_context.Raw_level.to_int32
                                          curr_level)
                                        (Int32.add
                                          (Alpha_context.Raw_level.to_int32 l)
                                          (* ❌ Constant of type int32 is converted to int *)
                                          10)))))))))).

Definition test_block_reward {A : Type}
  (priority : Z) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion
    match priority with
    | 0 =>
      op_startypeminuserrorstar op_startypeminuserrorstar
        (fun min => __return ((op_startypeminuserrorstar 16), min))
    | 1 =>
      op_startypeminuserrorstar op_startypeminuserrorstar
        (fun min => __return ((op_startypeminuserrorstar 8), min))
    | 3 =>
      op_startypeminuserrorstar op_startypeminuserrorstar
        (fun min => __return ((op_startypeminuserrorstar 4), min))
    | _ => fail (invalid_arg "prio should be 0, 1, or 3" % string)
    end
    (fun function_parameter =>
      let '(expected_reward_max_endo, expected_reward_min_endo) :=
        function_parameter in
      let endorsers_per_block := 32 in
      op_gtgteqquestion (op_startypeminuserrorstar endorsers_per_block 32)
        (fun function_parameter =>
          let '(b, _) := function_parameter in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar)
            (fun endorsers =>
              op_gtgteqquestion
                (fold_left_s
                  (fun ops =>
                    fun endorser =>
                      let delegate := delegate endorser in
                      op_gtgteqquestion
                        (op_startypeminuserrorstar delegate
                          op_startypeminuserrorstar tt)
                        (fun op => __return (cons (Operation.pack op) ops))) []
                  endorsers)
                (fun ops =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar ops b)
                    (fun b =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          priority 32)
                        (fun baking_reward =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar __LOC__ baking_reward
                              expected_reward_max_endo)
                            (fun function_parameter =>
                              let 'tt := function_parameter in
                              op_gtgteqquestion
                                (op_startypeminuserrorstar
                                  op_startypeminuserrorstar priority 0)
                                (fun baking_reward =>
                                  op_startypeminuserrorstar __LOC__
                                    baking_reward expected_reward_min_endo)))))))).

Definition tests {A : Type} : list A :=
  cons
    (op_startypeminuserrorstar "cycle" % string
      (* ❌ Variants not supported *)
      variant test_cycle)
    (cons
      (op_startypeminuserrorstar "block_reward for priority 0" % string
        (* ❌ Variants not supported *)
        variant (test_block_reward 0))
      (cons
        (op_startypeminuserrorstar "block_reward for priority 1" % string
          (* ❌ Variants not supported *)
          variant (test_block_reward 1))
        (cons
          (op_startypeminuserrorstar "block_reward for priority 3" % string
            (* ❌ Variants not supported *)
            variant (test_block_reward 3)) []))).
test/combined_operations.ml 137 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Multiple operations can be grouped in one ensuring their
    derministic application.

    If an invalid operation is present in this group of operation, the
    previous applied operations are backtracked leaving the context
    unchanged and the following operations are skipped. Fees attributed
    to the operations are collected by the baker nonetheless.

    Only manager operations are allowed in multiple transactions.
    They must all belong to the same manager as there is only one signature. *)

open Protocol
open Test_tez
open Test_utils

let ten_tez = Tez.of_int 10

(** Groups ten transactions between the same parties. *)
let multiple_transfers () =
  Context.init 3
  >>=? fun (blk, contracts) ->
  let c1 = List.nth contracts 0 in
  let c2 = List.nth contracts 1 in
  let c3 = List.nth contracts 2 in
  map_s (fun _ -> Op.transaction (B blk) c1 c2 Tez.one) (1 -- 10)
  >>=? fun ops ->
  Op.combine_operations ~source:c1 (B blk) ops
  >>=? fun operation ->
  Context.Contract.balance (B blk) c1
  >>=? fun c1_old_balance ->
  Context.Contract.balance (B blk) c2
  >>=? fun c2_old_balance ->
  Context.Contract.pkh c3
  >>=? fun baker_pkh ->
  Block.bake ~policy:(By_account baker_pkh) ~operation blk
  >>=? fun blk ->
  Assert.balance_was_debited
    ~loc:__LOC__
    (B blk)
    c1
    c1_old_balance
    (Tez.of_int 10)
  >>=? fun () ->
  Assert.balance_was_credited
    ~loc:__LOC__
    (B blk)
    c2
    c2_old_balance
    (Tez.of_int 10)
  >>=? fun () -> return_unit

(** Groups ten delegated originations. *)
let multiple_origination_and_delegation () =
  Context.init 2
  >>=? fun (blk, contracts) ->
  let c1 = List.nth contracts 0 in
  let c2 = List.nth contracts 1 in
  let n = 10 in
  Context.get_constants (B blk)
  >>=? fun {parametric = {origination_size; cost_per_byte; _}; _} ->
  Context.Contract.pkh c2
  >>=? fun delegate_pkh ->
  (* Deploy n smart contracts with dummy scripts from c1 *)
  map_s
    (fun i ->
      Op.origination
        ~delegate:delegate_pkh
        ~counter:(Z.of_int i)
        ~fee:Tez.zero
        ~script:Op.dummy_script
        ~credit:(Tez.of_int 10)
        (B blk)
        c1)
    (1 -- n)
  >>=? fun originations ->
  (* These computed originated contracts are not the ones really created *)
  (* We will extract them from the tickets *)
  let (originations_operations, _) = List.split originations in
  Op.combine_operations ~source:c1 (B blk) originations_operations
  >>=? fun operation ->
  Context.Contract.balance (B blk) c1
  >>=? fun c1_old_balance ->
  Incremental.begin_construction blk
  >>=? fun inc ->
  Incremental.add_operation inc operation
  >>=? fun inc ->
  (* To retrieve the originated contracts, it is easier to extract them
     from the tickets. Else, we could (could we ?) hash each combined
     operation individually. *)
  let tickets = Incremental.rev_tickets inc in
  let open Apply_results in
  let tickets =
    List.fold_left
      (fun acc -> function No_operation_metadata -> assert false
        | Operation_metadata {contents} ->
            to_list (Contents_result_list contents) @ acc)
      []
      tickets
    |> List.rev
  in
  let new_contracts =
    List.map
      (function
        | Contents_result
            (Manager_operation_result
              { operation_result =
                  Applied (Origination_result {originated_contracts = [h]; _});
                _ }) ->
            h
        | _ ->
            assert false)
      tickets
  in
  (* Previous balance - (Credit (n * 10tz) + Origination cost (n tz)) *)
  Tez.(cost_per_byte *? Int64.of_int origination_size)
  >>?= fun origination_burn ->
  Tez.(origination_burn *? Int64.of_int n)
  >>?= fun origination_total_cost ->
  Lwt.return
    ( Tez.( *? ) Op.dummy_script_cost 10L
    >>? Tez.( +? ) (Tez.of_int (10 * n))
    >>? Tez.( +? ) origination_total_cost )
  >>=? fun total_cost ->
  Assert.balance_was_debited ~loc:__LOC__ (I inc) c1 c1_old_balance total_cost
  >>=? fun () ->
  iter_s
    (fun c -> Assert.balance_is ~loc:__LOC__ (I inc) c (Tez.of_int 10))
    new_contracts
  >>=? fun () -> return_unit

let expect_balance_too_low = function
  | Environment.Ecoproto_error (Contract_storage.Balance_too_low _) :: _ ->
      return_unit
  | _ ->
      failwith
        "Contract should not have a sufficient balance : operation expected \
         to fail."

(** Groups three operations, the midlle one failing.
    Checks that the receipt is consistent.
    Variant without fees. *)
let failing_operation_in_the_middle () =
  Context.init 2
  >>=? fun (blk, contracts) ->
  let c1 = List.nth contracts 0 in
  let c2 = List.nth contracts 1 in
  Op.transaction ~fee:Tez.zero (B blk) c1 c2 Tez.one
  >>=? fun op1 ->
  Op.transaction ~fee:Tez.zero (B blk) c1 c2 Tez.max_tez
  >>=? fun op2 ->
  Op.transaction ~fee:Tez.zero (B blk) c1 c2 Tez.one
  >>=? fun op3 ->
  let operations = [op1; op2; op3] in
  Op.combine_operations ~source:c1 (B blk) operations
  >>=? fun operation ->
  Context.Contract.balance (B blk) c1
  >>=? fun c1_old_balance ->
  Context.Contract.balance (B blk) c2
  >>=? fun c2_old_balance ->
  Incremental.begin_construction blk
  >>=? fun inc ->
  Incremental.add_operation
    ~expect_failure:expect_balance_too_low
    inc
    operation
  >>=? fun inc ->
  let tickets = Incremental.rev_tickets inc in
  let open Apply_results in
  let tickets =
    List.fold_left
      (fun acc -> function No_operation_metadata -> assert false
        | Operation_metadata {contents} ->
            to_list (Contents_result_list contents) @ acc)
      []
      tickets
  in
  ( match tickets with
  | Contents_result
      (Manager_operation_result {operation_result = Backtracked _; _})
    :: Contents_result
         (Manager_operation_result
           { operation_result = Failed (_, [Contract_storage.Balance_too_low _]);
             _ })
       :: Contents_result
            (Manager_operation_result {operation_result = Skipped _; _})
          :: _ ->
      ()
  | _ ->
      assert false ) ;
  Assert.balance_is ~loc:__LOC__ (I inc) c1 c1_old_balance
  >>=? fun () ->
  Assert.balance_is ~loc:__LOC__ (I inc) c2 c2_old_balance
  >>=? fun () -> return_unit

(** Groups three operations, the midlle one failing.
    Checks that the receipt is consistent.
    Variant with fees, that should be spent even in case of failure. *)
let failing_operation_in_the_middle_with_fees () =
  Context.init 2
  >>=? fun (blk, contracts) ->
  let c1 = List.nth contracts 0 in
  let c2 = List.nth contracts 1 in
  Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez.one
  >>=? fun op1 ->
  Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez.max_tez
  >>=? fun op2 ->
  Op.transaction ~fee:Tez.one (B blk) c1 c2 Tez.one
  >>=? fun op3 ->
  let operations = [op1; op2; op3] in
  Op.combine_operations ~source:c1 (B blk) operations
  >>=? fun operation ->
  Context.Contract.balance (B blk) c1
  >>=? fun c1_old_balance ->
  Context.Contract.balance (B blk) c2
  >>=? fun c2_old_balance ->
  Incremental.begin_construction blk
  >>=? fun inc ->
  Incremental.add_operation
    ~expect_failure:expect_balance_too_low
    inc
    operation
  >>=? fun inc ->
  let tickets = Incremental.rev_tickets inc in
  let open Apply_results in
  let tickets =
    List.fold_left
      (fun acc -> function No_operation_metadata -> assert false
        | Operation_metadata {contents} ->
            to_list (Contents_result_list contents) @ acc)
      []
      tickets
  in
  ( match tickets with
  | Contents_result
      (Manager_operation_result {operation_result = Backtracked _; _})
    :: Contents_result
         (Manager_operation_result
           { operation_result = Failed (_, [Contract_storage.Balance_too_low _]);
             _ })
       :: Contents_result
            (Manager_operation_result {operation_result = Skipped _; _})
          :: _ ->
      ()
  | _ ->
      assert false ) ;
  (* In the presence of a failure, all the fees are collected. Even for skipped operations. *)
  Assert.balance_was_debited
    ~loc:__LOC__
    (I inc)
    c1
    c1_old_balance
    (Tez.of_int 3)
  >>=? fun () ->
  Assert.balance_is ~loc:__LOC__ (I inc) c2 c2_old_balance
  >>=? fun () -> return_unit

let tests =
  [ Test.tztest "multiple transfers" `Quick multiple_transfers;
    Test.tztest
      "multiple originations and delegations"
      `Quick
      multiple_origination_and_delegation;
    Test.tztest
      "Failing operation in the middle"
      `Quick
      failing_operation_in_the_middle;
    Test.tztest
      "Failing operation in the middle (with fees)"
      `Quick
      failing_operation_in_the_middle_with_fees ]
combined_operations_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Protocol.

Definition ten_tez {A : Type} : A := op_startypeminuserrorstar 10.

Definition multiple_transfers (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 3)
    (fun function_parameter =>
      let '(blk, contracts) := function_parameter in
      let c1 := op_startypeminuserrorstar contracts 0 in
      let c2 := op_startypeminuserrorstar contracts 1 in
      let c3 := op_startypeminuserrorstar contracts 2 in
      op_gtgteqquestion
        (map_s
          (fun function_parameter =>
            let '_ := function_parameter in
            op_startypeminuserrorstar op_startypeminuserrorstar c1 c2
              op_startypeminuserrorstar) (op_startypeminuserrorstar 1 10))
        (fun ops =>
          op_gtgteqquestion
            (op_startypeminuserrorstar c1 op_startypeminuserrorstar ops)
            (fun operation =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar c1)
                (fun c1_old_balance =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar c2)
                    (fun c2_old_balance =>
                      op_gtgteqquestion (op_startypeminuserrorstar c3)
                        (fun baker_pkh =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar op_startypeminuserrorstar
                              operation blk)
                            (fun blk =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar __LOC__
                                  op_startypeminuserrorstar c1 c1_old_balance
                                  (op_startypeminuserrorstar 10))
                                (fun function_parameter =>
                                  let 'tt := function_parameter in
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar __LOC__
                                      op_startypeminuserrorstar c2
                                      c2_old_balance
                                      (op_startypeminuserrorstar 10))
                                    (fun function_parameter =>
                                      let 'tt := function_parameter in
                                      return_unit))))))))).

Definition multiple_origination_and_delegation {A : Type}
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(blk, contracts) := function_parameter in
      let c1 := op_startypeminuserrorstar contracts 0 in
      let c2 := op_startypeminuserrorstar contracts 1 in
      let n := 10 in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
        (fun function_parameter =>
          let '_ := function_parameter in
          op_gtgteqquestion (op_startypeminuserrorstar c2)
            (fun delegate_pkh =>
              op_gtgteqquestion
                (map_s
                  (fun i =>
                    op_startypeminuserrorstar delegate_pkh (Z.of_int i)
                      op_startypeminuserrorstar op_startypeminuserrorstar
                      (op_startypeminuserrorstar 10) op_startypeminuserrorstar
                      c1) (op_startypeminuserrorstar 1 n))
                (fun originations =>
                  let '(originations_operations, _) := List.split originations
                    in
                  op_gtgteqquestion
                    (op_startypeminuserrorstar c1 op_startypeminuserrorstar
                      originations_operations)
                    (fun operation =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar c1)
                        (fun c1_old_balance =>
                          op_gtgteqquestion (op_startypeminuserrorstar blk)
                            (fun inc =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar inc operation)
                                (fun inc =>
                                  let tickets := op_startypeminuserrorstar inc
                                    in
                                  let tickets :=
                                    op_pipegt
                                      (List.fold_left
                                        (fun acc =>
                                          fun function_parameter =>
                                            match function_parameter with
                                            |
                                              Tezos_protocol_alpha.Protocol.Apply_results.No_operation_metadata
                                              =>
                                              (* ❌ Assert instruction is not handled. *)
                                              assert false
                                            |
                                              Tezos_protocol_alpha.Protocol.Apply_results.Operation_metadata
                                                {| contents := contents |} =>
                                              op_at
                                                (to_list
                                                  (Tezos_protocol_alpha.Protocol.Apply_results.Contents_result_list
                                                    contents)) acc
                                            end) [] tickets) List.rev in
                                  let new_contracts :=
                                    List.map
                                      (fun function_parameter =>
                                        match function_parameter with
                                        |
                                          Tezos_protocol_alpha.Protocol.Apply_results.Contents_result
                                            (Tezos_protocol_alpha.Protocol.Apply_results.Manager_operation_result
                                              {|
                                              operation_result :=
                                                Tezos_protocol_alpha.Protocol.Apply_results.Applied
                                                  (Tezos_protocol_alpha.Protocol.Apply_results.Origination_result
                                                    {|
                                                    originated_contracts := cons h []
                                                      |})
                                                |}) => h
                                        | _ =>
                                          (* ❌ Assert instruction is not handled. *)
                                          assert false
                                        end) tickets in
                                  op_startypeminuserrorstar
                                    op_startypeminuserrorstar
                                    (fun origination_burn =>
                                      op_startypeminuserrorstar
                                        op_startypeminuserrorstar
                                        (fun origination_total_cost =>
                                          op_gtgteqquestion
                                            (Lwt.__return
                                              (op_gtgtquestion
                                                (op_gtgtquestion
                                                  (op_startypeminuserrorstar
                                                    op_startypeminuserrorstar
                                                    (* ❌ Constant of type int64 is converted to int *)
                                                    10)
                                                  (op_startypeminuserrorstar
                                                    (op_startypeminuserrorstar
                                                      (op_star 10 n))))
                                                (op_startypeminuserrorstar
                                                  origination_total_cost)))
                                            (fun total_cost =>
                                              op_gtgteqquestion
                                                (op_startypeminuserrorstar
                                                  __LOC__
                                                  op_startypeminuserrorstar c1
                                                  c1_old_balance total_cost)
                                                (fun function_parameter =>
                                                  let 'tt := function_parameter
                                                    in
                                                  op_gtgteqquestion
                                                    (iter_s
                                                      (fun c =>
                                                        op_startypeminuserrorstar
                                                          __LOC__
                                                          op_startypeminuserrorstar
                                                          c
                                                          (op_startypeminuserrorstar
                                                            10)) new_contracts)
                                                    (fun function_parameter =>
                                                      let 'tt :=
                                                        function_parameter in
                                                      return_unit))))))))))))).

Definition expect_balance_too_low
  (function_parameter : list Tezos_base__TzPervasives.Error_monad.error)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  match function_parameter with
  |
    cons
      (Tezos_base__TzPervasives.Error_monad.Ecoproto_error
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
          _ _ _)) _ => return_unit
  | _ =>
    failwith
      "Contract should not have a sufficient balance : operation expected to fail."
        % string
  end.

Definition failing_operation_in_the_middle (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(blk, contracts) := function_parameter in
      let c1 := op_startypeminuserrorstar contracts 0 in
      let c2 := op_startypeminuserrorstar contracts 1 in
      op_gtgteqquestion
        (op_startypeminuserrorstar op_startypeminuserrorstar
          op_startypeminuserrorstar c1 c2 op_startypeminuserrorstar)
        (fun op1 =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar
              op_startypeminuserrorstar c1 c2 op_startypeminuserrorstar)
            (fun op2 =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar
                  op_startypeminuserrorstar c1 c2 op_startypeminuserrorstar)
                (fun op3 =>
                  let operations := cons op1 (cons op2 (cons op3 [])) in
                  op_gtgteqquestion
                    (op_startypeminuserrorstar c1 op_startypeminuserrorstar
                      operations)
                    (fun operation =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar c1)
                        (fun c1_old_balance =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar op_startypeminuserrorstar
                              c2)
                            (fun c2_old_balance =>
                              op_gtgteqquestion (op_startypeminuserrorstar blk)
                                (fun inc =>
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar
                                      expect_balance_too_low inc operation)
                                    (fun inc =>
                                      let tickets :=
                                        op_startypeminuserrorstar inc in
                                      let tickets :=
                                        List.fold_left
                                          (fun acc =>
                                            fun function_parameter =>
                                              match function_parameter with
                                              |
                                                Tezos_protocol_alpha.Protocol.Apply_results.No_operation_metadata
                                                =>
                                                (* ❌ Assert instruction is not handled. *)
                                                assert false
                                              |
                                                Tezos_protocol_alpha.Protocol.Apply_results.Operation_metadata
                                                  {| contents := contents |} =>
                                                op_at
                                                  (to_list
                                                    (Tezos_protocol_alpha.Protocol.Apply_results.Contents_result_list
                                                      contents)) acc
                                              end) [] tickets in
                                      (* ❌ Sequences of instructions are not handled (operator ";") *)
                                      let _ :=
                                        match tickets with
                                        |
                                          cons
                                            (Tezos_protocol_alpha.Protocol.Apply_results.Contents_result
                                              (Tezos_protocol_alpha.Protocol.Apply_results.Manager_operation_result
                                                {|
                                                operation_result :=
                                                  Tezos_protocol_alpha.Protocol.Apply_results.Backtracked
                                                    _
                                                    _
                                                  |}))
                                            (cons
                                              (Tezos_protocol_alpha.Protocol.Apply_results.Contents_result
                                                (Tezos_protocol_alpha.Protocol.Apply_results.Manager_operation_result
                                                  {|
                                                  operation_result :=
                                                    Tezos_protocol_alpha.Protocol.Apply_results.Failed
                                                      _
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                                          _
                                                          _
                                                          _)
                                                        [])
                                                    |}))
                                              (cons
                                                (Tezos_protocol_alpha.Protocol.Apply_results.Contents_result
                                                  (Tezos_protocol_alpha.Protocol.Apply_results.Manager_operation_result
                                                    {|
                                                    operation_result := Tezos_protocol_alpha.Protocol.Apply_results.Skipped _
                                                      |})) _)) => tt
                                        | _ =>
                                          (* ❌ Assert instruction is not handled. *)
                                          assert false
                                        end in
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar __LOC__
                                          op_startypeminuserrorstar c1
                                          c1_old_balance)
                                        (fun function_parameter =>
                                          let 'tt := function_parameter in
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar __LOC__
                                              op_startypeminuserrorstar c2
                                              c2_old_balance)
                                            (fun function_parameter =>
                                              let 'tt := function_parameter in
                                              return_unit))))))))))).

Definition failing_operation_in_the_middle_with_fees (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(blk, contracts) := function_parameter in
      let c1 := op_startypeminuserrorstar contracts 0 in
      let c2 := op_startypeminuserrorstar contracts 1 in
      op_gtgteqquestion
        (op_startypeminuserrorstar op_startypeminuserrorstar
          op_startypeminuserrorstar c1 c2 op_startypeminuserrorstar)
        (fun op1 =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar
              op_startypeminuserrorstar c1 c2 op_startypeminuserrorstar)
            (fun op2 =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar
                  op_startypeminuserrorstar c1 c2 op_startypeminuserrorstar)
                (fun op3 =>
                  let operations := cons op1 (cons op2 (cons op3 [])) in
                  op_gtgteqquestion
                    (op_startypeminuserrorstar c1 op_startypeminuserrorstar
                      operations)
                    (fun operation =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar c1)
                        (fun c1_old_balance =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar op_startypeminuserrorstar
                              c2)
                            (fun c2_old_balance =>
                              op_gtgteqquestion (op_startypeminuserrorstar blk)
                                (fun inc =>
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar
                                      expect_balance_too_low inc operation)
                                    (fun inc =>
                                      let tickets :=
                                        op_startypeminuserrorstar inc in
                                      let tickets :=
                                        List.fold_left
                                          (fun acc =>
                                            fun function_parameter =>
                                              match function_parameter with
                                              |
                                                Tezos_protocol_alpha.Protocol.Apply_results.No_operation_metadata
                                                =>
                                                (* ❌ Assert instruction is not handled. *)
                                                assert false
                                              |
                                                Tezos_protocol_alpha.Protocol.Apply_results.Operation_metadata
                                                  {| contents := contents |} =>
                                                op_at
                                                  (to_list
                                                    (Tezos_protocol_alpha.Protocol.Apply_results.Contents_result_list
                                                      contents)) acc
                                              end) [] tickets in
                                      (* ❌ Sequences of instructions are not handled (operator ";") *)
                                      let _ :=
                                        match tickets with
                                        |
                                          cons
                                            (Tezos_protocol_alpha.Protocol.Apply_results.Contents_result
                                              (Tezos_protocol_alpha.Protocol.Apply_results.Manager_operation_result
                                                {|
                                                operation_result :=
                                                  Tezos_protocol_alpha.Protocol.Apply_results.Backtracked
                                                    _
                                                    _
                                                  |}))
                                            (cons
                                              (Tezos_protocol_alpha.Protocol.Apply_results.Contents_result
                                                (Tezos_protocol_alpha.Protocol.Apply_results.Manager_operation_result
                                                  {|
                                                  operation_result :=
                                                    Tezos_protocol_alpha.Protocol.Apply_results.Failed
                                                      _
                                                      (cons
                                                        (Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                                          _
                                                          _
                                                          _)
                                                        [])
                                                    |}))
                                              (cons
                                                (Tezos_protocol_alpha.Protocol.Apply_results.Contents_result
                                                  (Tezos_protocol_alpha.Protocol.Apply_results.Manager_operation_result
                                                    {|
                                                    operation_result := Tezos_protocol_alpha.Protocol.Apply_results.Skipped _
                                                      |})) _)) => tt
                                        | _ =>
                                          (* ❌ Assert instruction is not handled. *)
                                          assert false
                                        end in
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar __LOC__
                                          op_startypeminuserrorstar c1
                                          c1_old_balance
                                          (op_startypeminuserrorstar 3))
                                        (fun function_parameter =>
                                          let 'tt := function_parameter in
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar __LOC__
                                              op_startypeminuserrorstar c2
                                              c2_old_balance)
                                            (fun function_parameter =>
                                              let 'tt := function_parameter in
                                              return_unit))))))))))).

Definition tests {A : Type} : list A :=
  cons
    (op_startypeminuserrorstar "multiple transfers" % string
      (* ❌ Variants not supported *)
      variant multiple_transfers)
    (cons
      (op_startypeminuserrorstar
        "multiple originations and delegations" % string
        (* ❌ Variants not supported *)
        variant multiple_origination_and_delegation)
      (cons
        (op_startypeminuserrorstar "Failing operation in the middle" % string
          (* ❌ Variants not supported *)
          variant failing_operation_in_the_middle)
        (cons
          (op_startypeminuserrorstar
            "Failing operation in the middle (with fees)" % string
            (* ❌ Variants not supported *)
            variant failing_operation_in_the_middle_with_fees) []))).
test/delegation.ml 938 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol
open Alpha_context
open Test_tez
open Test_utils

(**************************************************************************)
(* bootstrap contracts *)
(**************************************************************************)
(* Bootstrap contracts are heavily used in other tests. It is helpful
   to test some properties of these contracts, so we can correctly
   interpret the other tests that use them. *)

let expect_error err = function
  | err0 :: _ when err = err0 ->
      return_unit
  | _ ->
      failwith "Unexpected successful result"

let expect_alpha_error err = expect_error (Environment.Ecoproto_error err)

let expect_no_change_registered_delegate_pkh pkh = function
  | Environment.Ecoproto_error (Delegate_storage.No_deletion pkh0) :: _
    when pkh0 = pkh ->
      return_unit
  | _ ->
      failwith "Delegate can not be deleted and operation should fail."

(** bootstrap contracts delegate to themselves *)
let bootstrap_manager_is_bootstrap_delegate () =
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  let bootstrap0 = List.hd bootstrap_contracts in
  Context.Contract.delegate (B b) bootstrap0
  >>=? fun delegate0 ->
  Context.Contract.manager (B b) bootstrap0
  >>=? fun manager0 -> Assert.equal_pkh ~loc:__LOC__ delegate0 manager0.pkh

(** bootstrap contracts cannot change their delegate *)
let bootstrap_delegate_cannot_change ~fee () =
  Context.init 2
  >>=? fun (b, bootstrap_contracts) ->
  let bootstrap0 = List.nth bootstrap_contracts 0 in
  let bootstrap1 = List.nth bootstrap_contracts 1 in
  Context.Contract.pkh bootstrap0
  >>=? fun pkh1 ->
  Incremental.begin_construction b ~policy:(Block.Excluding [pkh1])
  >>=? fun i ->
  Context.Contract.manager (I i) bootstrap1
  >>=? fun manager1 ->
  Context.Contract.balance (I i) bootstrap0
  >>=? fun balance0 ->
  Context.Contract.delegate (I i) bootstrap0
  >>=? fun delegate0 ->
  (* change delegation to bootstrap1 *)
  Op.delegation ~fee (I i) bootstrap0 (Some manager1.pkh)
  >>=? fun set_delegate ->
  if fee > balance0 then
    Incremental.add_operation i set_delegate
    >>= fun err ->
    Assert.proto_error ~loc:__LOC__ err (function
        | Contract_storage.Balance_too_low _ ->
            true
        | _ ->
            false)
  else
    Incremental.add_operation
      ~expect_failure:(expect_no_change_registered_delegate_pkh delegate0)
      i
      set_delegate
    >>=? fun i ->
    Incremental.finalize_block i
    >>=? fun b ->
    (* bootstrap0 still has same delegate *)
    Context.Contract.delegate (B b) bootstrap0
    >>=? fun delegate0_after ->
    Assert.equal_pkh ~loc:__LOC__ delegate0_after delegate0
    >>=? fun () ->
    (* fee has been debited *)
    Assert.balance_was_debited ~loc:__LOC__ (B b) bootstrap0 balance0 fee

(** bootstrap contracts cannot delete their delegation *)
let bootstrap_delegate_cannot_be_removed ~fee () =
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  let bootstrap = List.hd bootstrap_contracts in
  Incremental.begin_construction b
  >>=? fun i ->
  Context.Contract.balance (I i) bootstrap
  >>=? fun balance ->
  Context.Contract.delegate (I i) bootstrap
  >>=? fun delegate ->
  Context.Contract.manager (I i) bootstrap
  >>=? fun manager ->
  (* remove delegation *)
  Op.delegation ~fee (I i) bootstrap None
  >>=? fun set_delegate ->
  if fee > balance then
    Incremental.add_operation i set_delegate
    >>= fun err ->
    Assert.proto_error ~loc:__LOC__ err (function
        | Contract_storage.Balance_too_low _ ->
            true
        | _ ->
            false)
  else
    Incremental.add_operation
      ~expect_failure:(expect_no_change_registered_delegate_pkh manager.pkh)
      i
      set_delegate
    >>=? fun i ->
    (* delegate has not changed *)
    Context.Contract.delegate (I i) bootstrap
    >>=? fun delegate_after ->
    Assert.equal_pkh ~loc:__LOC__ delegate delegate_after
    >>=? fun () ->
    (* fee has been debited *)
    Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance fee

(** contracts not registered as delegate can change their delegation *)
let delegate_can_be_changed_from_unregistered_contract ~fee () =
  Context.init 2
  >>=? fun (b, bootstrap_contracts) ->
  let bootstrap0 = List.hd bootstrap_contracts in
  let bootstrap1 = List.nth bootstrap_contracts 1 in
  let unregistered_account = Account.new_account () in
  let unregistered_pkh = Account.(unregistered_account.pkh) in
  let unregistered = Contract.implicit_contract unregistered_pkh in
  Incremental.begin_construction b
  >>=? fun i ->
  Context.Contract.manager (I i) bootstrap0
  >>=? fun manager0 ->
  Context.Contract.manager (I i) bootstrap1
  >>=? fun manager1 ->
  let credit = Tez.of_int 10 in
  Op.transaction ~fee:Tez.zero (I i) bootstrap0 unregistered credit
  >>=? fun credit_contract ->
  Context.Contract.balance (I i) bootstrap0
  >>=? fun balance ->
  Incremental.add_operation i credit_contract
  >>=? fun i ->
  (* delegate to bootstrap0 *)
  Op.delegation ~fee:Tez.zero (I i) unregistered (Some manager0.pkh)
  >>=? fun set_delegate ->
  Incremental.add_operation i set_delegate
  >>=? fun i ->
  Context.Contract.delegate (I i) unregistered
  >>=? fun delegate ->
  Assert.equal_pkh ~loc:__LOC__ delegate manager0.pkh
  >>=? fun () ->
  (* change delegation to bootstrap1 *)
  Op.delegation ~fee (I i) unregistered (Some manager1.pkh)
  >>=? fun change_delegate ->
  if fee > balance then
    Incremental.add_operation i change_delegate
    >>= fun err ->
    Assert.proto_error ~loc:__LOC__ err (function
        | Contract_storage.Balance_too_low _ ->
            true
        | _ ->
            false)
  else
    Incremental.add_operation i change_delegate
    >>=? fun i ->
    (* delegate has changed *)
    Context.Contract.delegate (I i) unregistered
    >>=? fun delegate_after ->
    Assert.equal_pkh ~loc:__LOC__ delegate_after manager1.pkh
    >>=? fun () ->
    (* fee has been debited *)
    Assert.balance_was_debited ~loc:__LOC__ (I i) unregistered credit fee

(** contracts not registered as delegate can delete their delegation *)
let delegate_can_be_removed_from_unregistered_contract ~fee () =
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  let bootstrap = List.hd bootstrap_contracts in
  let unregistered_account = Account.new_account () in
  let unregistered_pkh = Account.(unregistered_account.pkh) in
  let unregistered = Contract.implicit_contract unregistered_pkh in
  Incremental.begin_construction b
  >>=? fun i ->
  Context.Contract.manager (I i) bootstrap
  >>=? fun manager ->
  let credit = Tez.of_int 10 in
  Op.transaction ~fee:Tez.zero (I i) bootstrap unregistered credit
  >>=? fun credit_contract ->
  Context.Contract.balance (I i) bootstrap
  >>=? fun balance ->
  Incremental.add_operation i credit_contract
  >>=? fun i ->
  (* delegate to bootstrap *)
  Op.delegation ~fee:Tez.zero (I i) unregistered (Some manager.pkh)
  >>=? fun set_delegate ->
  Incremental.add_operation i set_delegate
  >>=? fun i ->
  Context.Contract.delegate (I i) unregistered
  >>=? fun delegate ->
  Assert.equal_pkh ~loc:__LOC__ delegate manager.pkh
  >>=? fun () ->
  (* remove delegation *)
  Op.delegation ~fee (I i) unregistered None
  >>=? fun delete_delegate ->
  if fee > balance then
    Incremental.add_operation i delete_delegate
    >>= fun err ->
    Assert.proto_error ~loc:__LOC__ err (function
        | Contract_storage.Balance_too_low _ ->
            true
        | _ ->
            false)
  else
    Incremental.add_operation i delete_delegate
    >>=? fun i ->
    (* the delegate has been removed *)
    Context.Contract.delegate_opt (I i) unregistered
    >>=? (function
           | None ->
               return_unit
           | Some _ ->
               failwith "Expected delegate to be removed")
    >>=? fun () ->
    (* fee has been debited *)
    Assert.balance_was_debited ~loc:__LOC__ (I i) unregistered credit fee

(** bootstrap keys are already registered as delegate keys *)
let bootstrap_manager_already_registered_delegate ~fee () =
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  Context.Contract.manager (I i) bootstrap
  >>=? fun manager ->
  let pkh = manager.pkh in
  let impl_contract = Contract.implicit_contract pkh in
  Context.Contract.balance (I i) impl_contract
  >>=? fun balance ->
  Op.delegation ~fee (I i) impl_contract (Some pkh)
  >>=? fun sec_reg ->
  if fee > balance then
    Incremental.add_operation i sec_reg
    >>= fun err ->
    Assert.proto_error ~loc:__LOC__ err (function
        | Contract_storage.Balance_too_low _ ->
            true
        | _ ->
            false)
  else
    Incremental.add_operation
      ~expect_failure:(function
        | Environment.Ecoproto_error Delegate_storage.Active_delegate :: _ ->
            return_unit
        | _ ->
            failwith "Delegate is already active and operation should fail.")
      i
      sec_reg
    >>=? fun i ->
    (* fee has been debited *)
    Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract balance fee

(** bootstrap manager can be set as delegate of an originated contract
    (through origination operation) *)
let delegate_to_bootstrap_by_origination ~fee () =
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  Context.Contract.manager (I i) bootstrap
  >>=? fun manager ->
  Context.Contract.balance (I i) bootstrap
  >>=? fun balance ->
  (* originate a contract with bootstrap's manager as delegate *)
  Op.origination
    ~fee
    ~credit:Tez.zero
    ~delegate:manager.pkh
    (I i)
    bootstrap
    ~script:Op.dummy_script
  >>=? fun (op, orig_contract) ->
  Context.get_constants (I i)
  >>=? fun {parametric = {origination_size; cost_per_byte; _}; _} ->
  (* 0.257tz *)
  Tez.(cost_per_byte *? Int64.of_int origination_size)
  >>?= fun origination_burn ->
  Lwt.return
    (Tez.( +? ) fee origination_burn >>? Tez.( +? ) Op.dummy_script_cost)
  >>=? fun total_fee ->
  if fee > balance then
    Incremental.add_operation i op
    >>= fun err ->
    Assert.proto_error ~loc:__LOC__ err (function
        | Contract_storage.Balance_too_low _ ->
            true
        | _ ->
            false)
  else if total_fee > balance && balance >= fee then
    (* origination did not proceed; fee has been debited *)
    Incremental.add_operation
      i
      ~expect_failure:(function
        | Environment.Ecoproto_error (Contract.Balance_too_low _) :: _ ->
            return_unit
        | _ ->
            failwith
              "Not enough balance for origination burn: operation should fail.")
      op
    >>=? fun i ->
    (* fee was taken *)
    Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance fee
    >>=? fun () ->
    (* originated contract has not been created *)
    Context.Contract.balance (I i) orig_contract
    >>= fun err ->
    Assert.error ~loc:__LOC__ err (function
        | RPC_context.Not_found _ ->
            true
        | _ ->
            false)
  else
    (* bootstrap is delegate, fee + origination burn have been debited *)
    Incremental.add_operation i op
    >>=? fun i ->
    Context.Contract.delegate (I i) orig_contract
    >>=? fun delegate ->
    Assert.equal_pkh ~loc:__LOC__ delegate manager.pkh
    >>=? fun () ->
    Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance total_fee

let tests_bootstrap_contracts =
  [ Test.tztest
      "bootstrap contracts delegate to themselves"
      `Quick
      bootstrap_manager_is_bootstrap_delegate;
    Test.tztest
      "bootstrap contracts can change their delegate (small fee)"
      `Quick
      (bootstrap_delegate_cannot_change ~fee:Tez.one_mutez);
    Test.tztest
      "bootstrap contracts can change their delegate (max fee)"
      `Quick
      (bootstrap_delegate_cannot_change ~fee:Tez.max_tez);
    Test.tztest
      "bootstrap contracts cannot remove their delegation (small fee)"
      `Quick
      (bootstrap_delegate_cannot_be_removed ~fee:Tez.one_mutez);
    Test.tztest
      "bootstrap contracts cannot remove their delegation (max fee)"
      `Quick
      (bootstrap_delegate_cannot_be_removed ~fee:Tez.max_tez);
    Test.tztest
      "contracts not registered as delegate can remove their delegation \
       (small fee)"
      `Quick
      (delegate_can_be_changed_from_unregistered_contract ~fee:Tez.one_mutez);
    Test.tztest
      "contracts not registered as delegate can remove their delegation (max \
       fee)"
      `Quick
      (delegate_can_be_changed_from_unregistered_contract ~fee:Tez.max_tez);
    Test.tztest
      "contracts not registered as delegate can remove their delegation \
       (small fee)"
      `Quick
      (delegate_can_be_removed_from_unregistered_contract ~fee:Tez.one_mutez);
    Test.tztest
      "contracts not registered as delegate can remove their delegation (max \
       fee)"
      `Quick
      (delegate_can_be_removed_from_unregistered_contract ~fee:Tez.max_tez);
    Test.tztest
      "bootstrap keys are already registered as delegate keys (small fee)"
      `Quick
      (bootstrap_manager_already_registered_delegate ~fee:Tez.one_mutez);
    Test.tztest
      "bootstrap keys are already registered as delegate keys (max fee)"
      `Quick
      (bootstrap_manager_already_registered_delegate ~fee:Tez.max_tez);
    Test.tztest
      "bootstrap manager can be delegate (init origination, small fee)"
      `Quick
      (delegate_to_bootstrap_by_origination ~fee:Tez.one_mutez);
    (* balance enough for fee but not for fee + origination burn + dummy script storage cost *)
    Test.tztest
      "bootstrap manager can be delegate (init origination, edge case)"
      `Quick
      (delegate_to_bootstrap_by_origination
         ~fee:(Tez.of_mutez_exn 3_999_999_705_000L));
    (* fee bigger than bootstrap's initial balance*)
    Test.tztest
      "bootstrap manager can be delegate (init origination, large fee)"
      `Quick
      (delegate_to_bootstrap_by_origination ~fee:(Tez.of_int 10_000_000)) ]

(**************************************************************************)
(* delegate registration *)
(**************************************************************************)
(* A delegate is a pkh. Delegates must be registered. Registration is
   done via the self-delegation of the implicit contract corresponding
   to the pkh. The implicit contract must be credited when the
   self-delegation is done. Furthermore, trying to register an already
   registered key raises an error.

   In this series of tests, we verify that
   1- unregistered delegate keys cannot be delegated to,
   2- registered keys can be delegated to,
   3- registering an already registered key raises an error.


   We consider three scenarios for setting a delegate:
   - through origination,
   - through delegation when the implicit contract has no delegate yet,
   - through delegation when the implicit contract already has a delegate.

   We also test that emptying the implicit contract linked to a
   registered delegate key does not unregister the delegate key.
*)

(*
   Valid registration

   Unregistered key:
   - contract not credited and no self-delegation
   - contract credited but no self-delegation
   - contract not credited and self-delegation

Not credited:
- no credit operation
- credit operation of 1μꜩ and then debit operation of 1μꜩ

*)

(** A- unregistered delegate keys cannot be used for delegation *)

(* Two main series of tests: without self-delegation, and with a failed attempt at self-delegation
   1- no self-delegation
     a- no credit
   - no token transfer
   - credit of 1μꜩ and then debit of 1μꜩ
     b- with credit of 1μꜩ.
     For every scenario, we try three different ways of delegating:
   - through origination (init origination)
   - through delegation when no delegate was assigned (init delegation)
   - through delegation when a delegate was assigned (switch delegation).

   2- Self-delegation fails if the contract has no credit. We try the
   two possibilities of 1a for non-credited contracts.
*)

let expect_unregistered_key pkh = function
  | Environment.Ecoproto_error (Roll_storage.Unregistered_delegate pkh0) :: _
    when pkh = pkh0 ->
      return_unit
  | _ ->
      failwith "Delegate key is not registered: operation should fail."

(* A1: no self-delegation *)
(* no token transfer, no self-delegation *)
let unregistered_delegate_key_init_origination ~fee () =
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  let unregistered_account = Account.new_account () in
  let unregistered_pkh = Account.(unregistered_account.pkh) in
  (* origination with delegate argument *)
  Op.origination
    ~fee
    ~delegate:unregistered_pkh
    (I i)
    bootstrap
    ~script:Op.dummy_script
  >>=? fun (op, orig_contract) ->
  Context.get_constants (I i)
  >>=? fun {parametric = {origination_size; cost_per_byte; _}; _} ->
  Tez.(cost_per_byte *? Int64.of_int origination_size)
  >>?= fun origination_burn ->
  Lwt.return (Tez.( +? ) fee origination_burn)
  >>=? fun _total_fee ->
  (* FIXME unused variable *)
  Context.Contract.balance (I i) bootstrap
  >>=? fun balance ->
  if fee > balance then
    Incremental.add_operation i op
    >>= fun err ->
    Assert.proto_error ~loc:__LOC__ err (function
        | Contract_storage.Balance_too_low _ ->
            true
        | _ ->
            false)
  else
    (* origination did not proceed; fee has been debited *)
    Incremental.add_operation
      ~expect_failure:(expect_unregistered_key unregistered_pkh)
      i
      op
    >>=? fun i ->
    Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance fee
    >>=? fun () ->
    (* originated contract has not been created *)
    Context.Contract.balance (I i) orig_contract
    >>= fun err ->
    Assert.error ~loc:__LOC__ err (function
        | RPC_context.Not_found _ ->
            true
        | _ ->
            false)

let unregistered_delegate_key_init_delegation ~fee () =
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  let unregistered_account = Account.new_account () in
  let unregistered_pkh = Account.(unregistered_account.pkh) in
  let impl_contract = Contract.implicit_contract unregistered_pkh in
  let unregistered_delegate_account = Account.new_account () in
  let unregistered_delegate_pkh =
    Account.(unregistered_delegate_account.pkh)
  in
  (* initial credit for the delegated contract *)
  let credit = Tez.of_int 10 in
  Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract credit
  >>=? fun credit_contract ->
  Incremental.add_operation i credit_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract credit
  >>=? fun _ ->
  (* try to delegate *)
  Op.delegation ~fee (I i) impl_contract (Some unregistered_delegate_pkh)
  >>=? fun delegate_op ->
  if fee > credit then
    Incremental.add_operation i delegate_op
    >>= fun err ->
    Assert.proto_error ~loc:__LOC__ err (function
        | Contract_storage.Balance_too_low _ ->
            true
        | _ ->
            false)
  else
    (* fee has been debited; no delegate *)
    Incremental.add_operation
      i
      ~expect_failure:(expect_unregistered_key unregistered_delegate_pkh)
      delegate_op
    >>=? fun i ->
    Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract credit fee
    >>=? fun () ->
    (* implicit contract has no delegate *)
    Context.Contract.delegate (I i) impl_contract
    >>= fun err ->
    Assert.error ~loc:__LOC__ err (function
        | RPC_context.Not_found _ ->
            true
        | _ ->
            false)

let unregistered_delegate_key_switch_delegation ~fee () =
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  let bootstrap_pkh =
    Contract.is_implicit bootstrap |> Option.unopt_assert ~loc:__POS__
  in
  let unregistered_account = Account.new_account () in
  let unregistered_pkh = Account.(unregistered_account.pkh) in
  let impl_contract = Contract.implicit_contract unregistered_pkh in
  let unregistered_delegate_account = Account.new_account () in
  let unregistered_delegate_pkh =
    Account.(unregistered_delegate_account.pkh)
  in
  (* initial credit for the delegated contract *)
  let credit = Tez.of_int 10 in
  Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract credit
  >>=? fun init_credit ->
  Incremental.add_operation i init_credit
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract credit
  >>=? fun _ ->
  (* set and check the initial delegate *)
  Op.delegation ~fee:Tez.zero (I i) impl_contract (Some bootstrap_pkh)
  >>=? fun delegate_op ->
  Incremental.add_operation i delegate_op
  >>=? fun i ->
  Context.Contract.delegate (I i) bootstrap
  >>=? fun delegate_pkh ->
  Assert.equal_pkh ~loc:__LOC__ bootstrap_pkh delegate_pkh
  >>=? fun () ->
  (* try to delegate *)
  Op.delegation ~fee (I i) impl_contract (Some unregistered_delegate_pkh)
  >>=? fun delegate_op ->
  if fee > credit then
    Incremental.add_operation i delegate_op
    >>= fun err ->
    Assert.proto_error ~loc:__LOC__ err (function
        | Contract_storage.Balance_too_low _ ->
            true
        | _ ->
            false)
  else
    (* fee has been debited; no delegate *)
    Incremental.add_operation
      i
      ~expect_failure:(expect_unregistered_key unregistered_delegate_pkh)
      delegate_op
    >>=? fun i ->
    Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract credit fee
    >>=? fun () ->
    (* implicit contract delegate has not changed *)
    Context.Contract.delegate (I i) bootstrap
    >>=? fun delegate_pkh_after ->
    Assert.equal_pkh ~loc:__LOC__ delegate_pkh delegate_pkh_after

(* credit of some amount, no self-delegation *)
let unregistered_delegate_key_init_origination_credit ~fee ~amount () =
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  let unregistered_account = Account.new_account () in
  let unregistered_pkh = Account.(unregistered_account.pkh) in
  let impl_contract = Contract.implicit_contract unregistered_pkh in
  (* credit + check balance *)
  Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract amount
  >>=? fun create_contract ->
  Incremental.add_operation i create_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount
  >>=? fun _ ->
  (* origination with delegate argument *)
  Context.Contract.balance (I i) bootstrap
  >>=? fun balance ->
  Op.origination
    ~fee
    ~delegate:unregistered_pkh
    (I i)
    bootstrap
    ~script:Op.dummy_script
  >>=? fun (op, orig_contract) ->
  if fee > balance then
    Incremental.add_operation i op
    >>= fun err ->
    Assert.proto_error ~loc:__LOC__ err (function
        | Contract_storage.Balance_too_low _ ->
            true
        | _ ->
            false)
  else
    (* origination not done, fee taken *)
    Incremental.add_operation
      ~expect_failure:(expect_unregistered_key unregistered_pkh)
      i
      op
    >>=? fun i ->
    Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance fee
    >>=? fun () ->
    Context.Contract.balance (I i) orig_contract
    >>= fun err ->
    Assert.error ~loc:__LOC__ err (function
        | RPC_context.Not_found _ ->
            true
        | _ ->
            false)

let unregistered_delegate_key_init_delegation_credit ~fee ~amount () =
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  let unregistered_account = Account.new_account () in
  let unregistered_pkh = Account.(unregistered_account.pkh) in
  let impl_contract = Contract.implicit_contract unregistered_pkh in
  let unregistered_delegate_account = Account.new_account () in
  let unregistered_delegate_pkh =
    Account.(unregistered_delegate_account.pkh)
  in
  (* credit + check balance *)
  Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract amount
  >>=? fun create_contract ->
  Incremental.add_operation i create_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount
  >>=? fun _ ->
  (* initial credit for the delegated contract *)
  let credit = Tez.of_int 10 in
  Lwt.return Tez.(credit +? amount)
  >>=? fun balance ->
  Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract credit
  >>=? fun init_credit ->
  Incremental.add_operation i init_credit
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract balance
  >>=? fun _ ->
  (* try to delegate *)
  Op.delegation ~fee (I i) impl_contract (Some unregistered_delegate_pkh)
  >>=? fun delegate_op ->
  if fee > credit then
    Incremental.add_operation i delegate_op
    >>= fun err ->
    Assert.proto_error ~loc:__LOC__ err (function
        | Contract_storage.Balance_too_low _ ->
            true
        | _ ->
            false)
  else
    (* fee has been taken, no delegate for contract *)
    Incremental.add_operation
      ~expect_failure:(expect_unregistered_key unregistered_delegate_pkh)
      i
      delegate_op
    >>=? fun i ->
    Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract balance fee
    >>=? fun () ->
    Context.Contract.delegate (I i) impl_contract
    >>= fun err ->
    Assert.error ~loc:__LOC__ err (function
        | RPC_context.Not_found _ ->
            true
        | _ ->
            false)

let unregistered_delegate_key_switch_delegation_credit ~fee ~amount () =
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  let bootstrap_pkh =
    Contract.is_implicit bootstrap |> Option.unopt_assert ~loc:__POS__
  in
  let unregistered_account = Account.new_account () in
  let unregistered_pkh = Account.(unregistered_account.pkh) in
  let impl_contract = Contract.implicit_contract unregistered_pkh in
  let unregistered_delegate_account = Account.new_account () in
  let unregistered_delegate_pkh =
    Account.(unregistered_delegate_account.pkh)
  in
  (* credit + check balance *)
  Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract amount
  >>=? fun create_contract ->
  Incremental.add_operation i create_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount
  >>=? fun _ ->
  (* initial credit for the delegated contract *)
  let credit = Tez.of_int 10 in
  Lwt.return Tez.(credit +? amount)
  >>=? fun balance ->
  Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract credit
  >>=? fun init_credit ->
  Incremental.add_operation i init_credit
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract balance
  >>=? fun _ ->
  (* set and check the initial delegate *)
  Op.delegation ~fee:Tez.zero (I i) impl_contract (Some bootstrap_pkh)
  >>=? fun delegate_op ->
  Incremental.add_operation i delegate_op
  >>=? fun i ->
  Context.Contract.delegate (I i) bootstrap
  >>=? fun delegate_pkh ->
  Assert.equal_pkh ~loc:__LOC__ bootstrap_pkh delegate_pkh
  >>=? fun () ->
  (* switch delegate through delegation *)
  Op.delegation ~fee (I i) impl_contract (Some unregistered_delegate_pkh)
  >>=? fun delegate_op ->
  if fee > credit then
    Incremental.add_operation i delegate_op
    >>= fun err ->
    Assert.proto_error ~loc:__LOC__ err (function
        | Contract_storage.Balance_too_low _ ->
            true
        | _ ->
            false)
  else
    (* fee has been taken, delegate for contract has not changed *)
    Incremental.add_operation
      ~expect_failure:(expect_unregistered_key unregistered_delegate_pkh)
      i
      delegate_op
    >>=? fun i ->
    Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract balance fee
    >>=? fun () ->
    Context.Contract.delegate (I i) impl_contract
    >>=? fun delegate ->
    Assert.not_equal_pkh ~loc:__LOC__ delegate unregistered_delegate_pkh
    >>=? fun () -> Assert.equal_pkh ~loc:__LOC__ delegate bootstrap_pkh

(* a credit of some amount followed by a debit of the same amount, no self-delegation *)
let unregistered_delegate_key_init_origination_credit_debit ~fee ~amount () =
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  let unregistered_account = Account.new_account () in
  let unregistered_pkh = Account.(unregistered_account.pkh) in
  let impl_contract = Contract.implicit_contract unregistered_pkh in
  (* credit + check balance *)
  Op.transaction (I i) bootstrap impl_contract amount
  >>=? fun create_contract ->
  Incremental.add_operation i create_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount
  >>=? fun _ ->
  (* debit + check balance *)
  Op.transaction (I i) impl_contract bootstrap amount
  >>=? fun debit_contract ->
  Incremental.add_operation i debit_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero
  >>=? fun _ ->
  (* origination with delegate argument *)
  Context.Contract.balance (I i) bootstrap
  >>=? fun balance ->
  Op.origination
    ~fee
    ~delegate:unregistered_pkh
    (I i)
    bootstrap
    ~script:Op.dummy_script
  >>=? fun (op, orig_contract) ->
  if fee > balance then
    Incremental.add_operation i op
    >>= fun err ->
    Assert.proto_error ~loc:__LOC__ err (function
        | Contract_storage.Balance_too_low _ ->
            true
        | _ ->
            false)
  else
    (* fee taken, origination not processed *)
    Incremental.add_operation
      ~expect_failure:(expect_unregistered_key unregistered_pkh)
      i
      op
    >>=? fun i ->
    Assert.balance_was_debited ~loc:__LOC__ (I i) bootstrap balance fee
    >>=? fun () ->
    Context.Contract.balance (I i) orig_contract
    >>= fun err ->
    Assert.error ~loc:__LOC__ err (function
        | RPC_context.Not_found _ ->
            true
        | _ ->
            false)

let unregistered_delegate_key_init_delegation_credit_debit ~amount ~fee () =
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  let unregistered_account = Account.new_account () in
  let unregistered_pkh = Account.(unregistered_account.pkh) in
  let impl_contract = Contract.implicit_contract unregistered_pkh in
  let unregistered_delegate_account = Account.new_account () in
  let unregistered_delegate_pkh =
    Account.(unregistered_delegate_account.pkh)
  in
  (* credit + check balance *)
  Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract amount
  >>=? fun create_contract ->
  Incremental.add_operation i create_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount
  >>=? fun _ ->
  (* debit + check balance *)
  Op.transaction ~fee:Tez.zero (I i) impl_contract bootstrap amount
  >>=? fun debit_contract ->
  Incremental.add_operation i debit_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero
  >>=? fun _ ->
  (* initial credit for the delegated contract *)
  let credit = Tez.of_int 10 in
  Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract credit
  >>=? fun credit_contract ->
  Incremental.add_operation i credit_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract credit
  >>=? fun _ ->
  (* try to delegate *)
  Op.delegation ~fee (I i) impl_contract (Some unregistered_delegate_pkh)
  >>=? fun delegate_op ->
  if fee > credit then
    Incremental.add_operation i delegate_op
    >>= fun err ->
    Assert.proto_error ~loc:__LOC__ err (function
        | Contract_storage.Balance_too_low _ ->
            true
        | _ ->
            false)
  else
    (* fee has been taken, no delegate for contract *)
    Incremental.add_operation
      ~expect_failure:(expect_unregistered_key unregistered_delegate_pkh)
      i
      delegate_op
    >>=? fun i ->
    Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract credit fee
    >>=? fun () ->
    Context.Contract.delegate (I i) impl_contract
    >>= fun err ->
    Assert.error ~loc:__LOC__ err (function
        | RPC_context.Not_found _ ->
            true
        | _ ->
            false)

let unregistered_delegate_key_switch_delegation_credit_debit ~fee ~amount () =
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  let bootstrap_pkh =
    Contract.is_implicit bootstrap |> Option.unopt_assert ~loc:__POS__
  in
  let unregistered_account = Account.new_account () in
  let unregistered_pkh = Account.(unregistered_account.pkh) in
  let impl_contract = Contract.implicit_contract unregistered_pkh in
  let unregistered_delegate_account = Account.new_account () in
  let unregistered_delegate_pkh =
    Account.(unregistered_delegate_account.pkh)
  in
  (* credit + check balance *)
  Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract amount
  >>=? fun create_contract ->
  Incremental.add_operation i create_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount
  >>=? fun _ ->
  (* debit + check balance *)
  Op.transaction (I i) impl_contract bootstrap amount
  >>=? fun debit_contract ->
  Incremental.add_operation i debit_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero
  >>=? fun _ ->
  (* delegation - initial credit for the delegated contract *)
  let credit = Tez.of_int 10 in
  Op.transaction ~fee:Tez.zero (I i) bootstrap impl_contract credit
  >>=? fun credit_contract ->
  Incremental.add_operation i credit_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract credit
  >>=? fun _ ->
  (* set and check the initial delegate *)
  Op.delegation ~fee:Tez.zero (I i) impl_contract (Some bootstrap_pkh)
  >>=? fun delegate_op ->
  Incremental.add_operation i delegate_op
  >>=? fun i ->
  Context.Contract.delegate (I i) bootstrap
  >>=? fun delegate_pkh ->
  Assert.equal_pkh ~loc:__LOC__ bootstrap_pkh delegate_pkh
  >>=? fun () ->
  (* switch delegate through delegation *)
  Op.delegation (I i) ~fee impl_contract (Some unregistered_delegate_pkh)
  >>=? fun delegate_op ->
  if fee > credit then
    Incremental.add_operation i delegate_op
    >>= fun err ->
    Assert.proto_error ~loc:__LOC__ err (function
        | Contract_storage.Balance_too_low _ ->
            true
        | _ ->
            false)
  else
    (* fee has been taken, delegate for contract has not changed *)
    Incremental.add_operation
      ~expect_failure:(expect_unregistered_key unregistered_delegate_pkh)
      i
      delegate_op
    >>=? fun i ->
    Assert.balance_was_debited ~loc:__LOC__ (I i) impl_contract credit fee
    >>=? fun () ->
    Context.Contract.delegate (I i) impl_contract
    >>=? fun delegate ->
    Assert.not_equal_pkh ~loc:__LOC__ delegate unregistered_delegate_pkh

(* A2- self-delegation to an empty contract fails *)
let failed_self_delegation_no_transaction () =
  Context.init 1
  >>=? fun (b, _) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let account = Account.new_account () in
  let unregistered_pkh = Account.(account.pkh) in
  let impl_contract = Contract.implicit_contract unregistered_pkh in
  (* check balance *)
  Context.Contract.balance (I i) impl_contract
  >>=? fun balance ->
  Assert.equal_tez ~loc:__LOC__ Tez.zero balance
  >>=? fun _ ->
  (* self delegation fails *)
  Op.delegation (I i) impl_contract (Some unregistered_pkh)
  >>=? fun self_delegation ->
  Incremental.add_operation i self_delegation
  >>= fun err ->
  Assert.proto_error ~loc:__LOC__ err (function
      | Contract_storage.Empty_implicit_contract pkh ->
          if pkh = unregistered_pkh then true else false
      | _ ->
          false)

let failed_self_delegation_emptied_implicit_contract amount () =
  (* create an implicit contract *)
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  let account = Account.new_account () in
  let unregistered_pkh = Account.(account.pkh) in
  let impl_contract = Contract.implicit_contract unregistered_pkh in
  (*  credit implicit contract and check balance *)
  Op.transaction (I i) bootstrap impl_contract amount
  >>=? fun create_contract ->
  Incremental.add_operation i create_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount
  >>=? fun _ ->
  (* empty implicit contract and check balance *)
  Op.transaction (I i) impl_contract bootstrap amount
  >>=? fun create_contract ->
  Incremental.add_operation i create_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero
  >>=? fun _ ->
  (* self delegation fails *)
  Op.delegation (I i) impl_contract (Some unregistered_pkh)
  >>=? fun self_delegation ->
  Incremental.add_operation i self_delegation
  >>= fun err ->
  Assert.proto_error ~loc:__LOC__ err (function
      | Contract_storage.Empty_implicit_contract pkh ->
          if pkh = unregistered_pkh then true else false
      | _ ->
          false)

(** B- valid registration:
    - credit implicit contract with some ꜩ + verification of balance
    - self delegation + verification
    - empty contract + verification of balance + verification of not being erased / self-delegation
    - create delegator implicit contract w first implicit contract as delegate + verification of delegation *)
let valid_delegate_registration_init_delegation_credit amount () =
  (* create an implicit contract *)
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  let delegate_account = Account.new_account () in
  let delegate_pkh = Account.(delegate_account.pkh) in
  let impl_contract = Contract.implicit_contract delegate_pkh in
  (* credit > 0ꜩ + check balance *)
  Op.transaction (I i) bootstrap impl_contract amount
  >>=? fun create_contract ->
  Incremental.add_operation i create_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount
  >>=? fun _ ->
  (* self delegation + verification *)
  Op.delegation (I i) impl_contract (Some delegate_pkh)
  >>=? fun self_delegation ->
  Incremental.add_operation i self_delegation
  >>=? fun i ->
  Context.Contract.delegate (I i) impl_contract
  >>=? fun delegate ->
  Assert.equal_pkh ~loc:__LOC__ delegate delegate_pkh
  >>=? fun _ ->
  (* create an implicit contract with no delegate *)
  let unregistered_account = Account.new_account () in
  let unregistered_pkh = Account.(unregistered_account.pkh) in
  let delegator = Contract.implicit_contract unregistered_pkh in
  Op.transaction ~fee:Tez.zero (I i) bootstrap delegator Tez.one
  >>=? fun credit_contract ->
  Incremental.add_operation i credit_contract
  >>=? fun i ->
  (* check no delegate for delegator contract *)
  Context.Contract.delegate (I i) delegator
  >>= fun err ->
  Assert.error ~loc:__LOC__ err (function
      | RPC_context.Not_found _ ->
          true
      | _ ->
          false)
  >>=? fun _ ->
  (* delegation to the newly registered key *)
  Op.delegation (I i) delegator (Some delegate_account.pkh)
  >>=? fun delegation ->
  Incremental.add_operation i delegation
  >>=? fun i ->
  (* check delegation *)
  Context.Contract.delegate (I i) delegator
  >>=? fun delegator_delegate ->
  Assert.equal_pkh ~loc:__LOC__ delegator_delegate delegate_pkh

let valid_delegate_registration_switch_delegation_credit amount () =
  (* create an implicit contract *)
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  let delegate_account = Account.new_account () in
  let delegate_pkh = Account.(delegate_account.pkh) in
  let impl_contract = Contract.implicit_contract delegate_pkh in
  (* credit > 0ꜩ + check balance *)
  Op.transaction (I i) bootstrap impl_contract amount
  >>=? fun create_contract ->
  Incremental.add_operation i create_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount
  >>=? fun _ ->
  (* self delegation + verification *)
  Op.delegation (I i) impl_contract (Some delegate_pkh)
  >>=? fun self_delegation ->
  Incremental.add_operation i self_delegation
  >>=? fun i ->
  Context.Contract.delegate (I i) impl_contract
  >>=? fun delegate ->
  Assert.equal_pkh ~loc:__LOC__ delegate delegate_pkh
  >>=? fun _ ->
  (* create an implicit contract with bootstrap's account as delegate *)
  let unregistered_account = Account.new_account () in
  let unregistered_pkh = Account.(unregistered_account.pkh) in
  let delegator = Contract.implicit_contract unregistered_pkh in
  Op.transaction ~fee:Tez.zero (I i) bootstrap delegator Tez.one
  >>=? fun credit_contract ->
  Incremental.add_operation i credit_contract
  >>=? fun i ->
  Context.Contract.manager (I i) bootstrap
  >>=? fun bootstrap_manager ->
  Op.delegation (I i) delegator (Some bootstrap_manager.pkh)
  >>=? fun delegation ->
  Incremental.add_operation i delegation
  >>=? fun i ->
  (* test delegate of new contract is bootstrap *)
  Context.Contract.delegate (I i) delegator
  >>=? fun delegator_delegate ->
  Assert.equal_pkh ~loc:__LOC__ delegator_delegate bootstrap_manager.pkh
  >>=? fun _ ->
  (* delegation with newly registered key *)
  Op.delegation (I i) delegator (Some delegate_account.pkh)
  >>=? fun delegation ->
  Incremental.add_operation i delegation
  >>=? fun i ->
  Context.Contract.delegate (I i) delegator
  >>=? fun delegator_delegate ->
  Assert.equal_pkh ~loc:__LOC__ delegator_delegate delegate_pkh

let valid_delegate_registration_init_delegation_credit_debit amount () =
  (* create an implicit contract *)
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  let delegate_account = Account.new_account () in
  let delegate_pkh = Account.(delegate_account.pkh) in
  let impl_contract = Contract.implicit_contract delegate_pkh in
  (* credit > 0ꜩ+ check balance *)
  Op.transaction (I i) bootstrap impl_contract amount
  >>=? fun create_contract ->
  Incremental.add_operation i create_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount
  >>=? fun _ ->
  (* self delegation + verification *)
  Op.delegation (I i) impl_contract (Some delegate_pkh)
  >>=? fun self_delegation ->
  Incremental.add_operation i self_delegation
  >>=? fun i ->
  Context.Contract.delegate (I i) impl_contract
  >>=? fun delegate ->
  Assert.equal_pkh ~loc:__LOC__ delegate_pkh delegate
  >>=? fun _ ->
  (* empty implicit contracts are usually deleted but they are kept if
     they were registered as delegates. we empty the contract in
     order to verify this. *)
  Op.transaction (I i) impl_contract bootstrap amount
  >>=? fun empty_contract ->
  Incremental.add_operation i empty_contract
  >>=? fun i ->
  (* impl_contract is empty *)
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero
  >>=? fun _ ->
  (* verify self-delegation after contract is emptied *)
  Context.Contract.delegate (I i) impl_contract
  >>=? fun delegate ->
  Assert.equal_pkh ~loc:__LOC__ delegate_pkh delegate
  >>=? fun _ ->
  (* create an implicit contract with no delegate *)
  let unregistered_account = Account.new_account () in
  let unregistered_pkh = Account.(unregistered_account.pkh) in
  let delegator = Contract.implicit_contract unregistered_pkh in
  Op.transaction ~fee:Tez.zero (I i) bootstrap delegator Tez.one
  >>=? fun credit_contract ->
  Incremental.add_operation i credit_contract
  >>=? fun i ->
  (* check no delegate for delegator contract *)
  Context.Contract.delegate (I i) delegator
  >>= fun err ->
  Assert.error ~loc:__LOC__ err (function
      | RPC_context.Not_found _ ->
          true
      | _ ->
          false)
  >>=? fun _ ->
  (* delegation to the newly registered key *)
  Op.delegation (I i) delegator (Some delegate_account.pkh)
  >>=? fun delegation ->
  Incremental.add_operation i delegation
  >>=? fun i ->
  (* check delegation *)
  Context.Contract.delegate (I i) delegator
  >>=? fun delegator_delegate ->
  Assert.equal_pkh ~loc:__LOC__ delegator_delegate delegate_pkh

let valid_delegate_registration_switch_delegation_credit_debit amount () =
  (* create an implicit contract *)
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  let delegate_account = Account.new_account () in
  let delegate_pkh = Account.(delegate_account.pkh) in
  let impl_contract = Contract.implicit_contract delegate_pkh in
  (* credit > 0ꜩ + check balance *)
  Op.transaction (I i) bootstrap impl_contract amount
  >>=? fun create_contract ->
  Incremental.add_operation i create_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract amount
  >>=? fun _ ->
  (* self delegation + verification *)
  Op.delegation (I i) impl_contract (Some delegate_pkh)
  >>=? fun self_delegation ->
  Incremental.add_operation i self_delegation
  >>=? fun i ->
  Context.Contract.delegate (I i) impl_contract
  >>=? fun delegate ->
  Assert.equal_pkh ~loc:__LOC__ delegate_pkh delegate
  >>=? fun _ ->
  (* empty implicit contracts are usually deleted but they are kept if
     they were registered as delegates. we empty the contract in
     order to verify this. *)
  Op.transaction (I i) impl_contract bootstrap amount
  >>=? fun empty_contract ->
  Incremental.add_operation i empty_contract
  >>=? fun i ->
  (* impl_contract is empty *)
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero
  >>=? fun _ ->
  (* create an implicit contract with bootstrap's account as delegate *)
  let unregistered_account = Account.new_account () in
  let unregistered_pkh = Account.(unregistered_account.pkh) in
  let delegator = Contract.implicit_contract unregistered_pkh in
  Op.transaction ~fee:Tez.zero (I i) bootstrap delegator Tez.one
  >>=? fun credit_contract ->
  Incremental.add_operation i credit_contract
  >>=? fun i ->
  Context.Contract.manager (I i) bootstrap
  >>=? fun bootstrap_manager ->
  Op.delegation (I i) delegator (Some bootstrap_manager.pkh)
  >>=? fun delegation ->
  Incremental.add_operation i delegation
  >>=? fun i ->
  (* test delegate of new contract is bootstrap *)
  Context.Contract.delegate (I i) delegator
  >>=? fun delegator_delegate ->
  Assert.equal_pkh ~loc:__LOC__ delegator_delegate bootstrap_manager.pkh
  >>=? fun _ ->
  (* delegation with newly registered key *)
  Op.delegation (I i) delegator (Some delegate_account.pkh)
  >>=? fun delegation ->
  Incremental.add_operation i delegation
  >>=? fun i ->
  Context.Contract.delegate (I i) delegator
  >>=? fun delegator_delegate ->
  Assert.equal_pkh ~loc:__LOC__ delegator_delegate delegate_pkh

(* with implicit contract with some credit *)

(** C- a second self-delegation should raise an `Active_delegate` error *)
let double_registration () =
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  let account = Account.new_account () in
  let pkh = Account.(account.pkh) in
  let impl_contract = Contract.implicit_contract pkh in
  (* credit 1μꜩ+ check balance *)
  Op.transaction (I i) bootstrap impl_contract Tez.one_mutez
  >>=? fun create_contract ->
  Incremental.add_operation i create_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.one_mutez
  >>=? fun _ ->
  (* self-delegation *)
  Op.delegation (I i) impl_contract (Some pkh)
  >>=? fun self_delegation ->
  Incremental.add_operation i self_delegation
  >>=? fun i ->
  (* second self-delegation *)
  Op.delegation (I i) impl_contract (Some pkh)
  >>=? fun second_registration ->
  Incremental.add_operation i second_registration
  >>= fun err ->
  Assert.proto_error ~loc:__LOC__ err (function
      | Delegate_storage.Active_delegate ->
          true
      | _ ->
          false)

(* with implicit contract emptied after first self-delegation  *)
let double_registration_when_empty () =
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  let account = Account.new_account () in
  let pkh = Account.(account.pkh) in
  let impl_contract = Contract.implicit_contract pkh in
  (* credit 1μꜩ+ check balance *)
  Op.transaction (I i) bootstrap impl_contract Tez.one_mutez
  >>=? fun create_contract ->
  Incremental.add_operation i create_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.one_mutez
  >>=? fun _ ->
  (* self delegation *)
  Op.delegation (I i) impl_contract (Some pkh)
  >>=? fun self_delegation ->
  Incremental.add_operation i self_delegation
  >>=? fun i ->
  (* empty the delegate account *)
  Op.transaction (I i) impl_contract bootstrap Tez.one_mutez
  >>=? fun empty_contract ->
  Incremental.add_operation i empty_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero
  >>=? fun _ ->
  (* second self-delegation *)
  Op.delegation (I i) impl_contract (Some pkh)
  >>=? fun second_registration ->
  Incremental.add_operation i second_registration
  >>= fun err ->
  Assert.proto_error ~loc:__LOC__ err (function
      | Delegate_storage.Active_delegate ->
          true
      | _ ->
          false)

(* with implicit contract emptied then recredited after first self-delegation  *)
let double_registration_when_recredited () =
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  let account = Account.new_account () in
  let pkh = Account.(account.pkh) in
  let impl_contract = Contract.implicit_contract pkh in
  (* credit 1μꜩ+ check balance *)
  Op.transaction (I i) bootstrap impl_contract Tez.one_mutez
  >>=? fun create_contract ->
  Incremental.add_operation i create_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.one_mutez
  >>=? fun _ ->
  (* self delegation *)
  Op.delegation (I i) impl_contract (Some pkh)
  >>=? fun self_delegation ->
  Incremental.add_operation i self_delegation
  >>=? fun i ->
  (* empty the delegate account *)
  Op.transaction (I i) impl_contract bootstrap Tez.one_mutez
  >>=? fun empty_contract ->
  Incremental.add_operation i empty_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.zero
  >>=? fun _ ->
  (* credit 1μꜩ+ check balance *)
  Op.transaction (I i) bootstrap impl_contract Tez.one_mutez
  >>=? fun create_contract ->
  Incremental.add_operation i create_contract
  >>=? fun i ->
  Assert.balance_is ~loc:__LOC__ (I i) impl_contract Tez.one_mutez
  >>=? fun _ ->
  (* second self-delegation *)
  Op.delegation (I i) impl_contract (Some pkh)
  >>=? fun second_registration ->
  Incremental.add_operation i second_registration
  >>= fun err ->
  Assert.proto_error ~loc:__LOC__ err (function
      | Delegate_storage.Active_delegate ->
          true
      | _ ->
          false)

(* self-delegation on unrevealed contract *)
let unregistered_and_unrevealed_self_delegate_key_init_delegation ~fee () =
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  let {Account.pkh; _} = Account.new_account () in
  let {Account.pkh = delegate_pkh; _} = Account.new_account () in
  let contract = Alpha_context.Contract.implicit_contract pkh in
  Op.transaction (I i) bootstrap contract (Tez.of_int 10)
  >>=? fun op ->
  Incremental.add_operation i op
  >>=? fun i ->
  Op.delegation ~fee (I i) contract (Some delegate_pkh)
  >>=? fun op ->
  Context.Contract.balance (I i) contract
  >>=? fun balance ->
  if fee > balance then
    Incremental.add_operation i op
    >>= fun err ->
    Assert.proto_error ~loc:__LOC__ err (function
        | Contract_storage.Balance_too_low _ ->
            true
        | _ ->
            false)
  else
    (* origination did not proceed; fee has been debited *)
    Incremental.add_operation
      ~expect_failure:(expect_unregistered_key delegate_pkh)
      i
      op
    >>=? fun i ->
    Assert.balance_was_debited ~loc:__LOC__ (I i) contract balance fee

(* self-delegation on revelead but not registered contract *)
let unregistered_and_revealed_self_delegate_key_init_delegation ~fee () =
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  let {Account.pkh; pk; _} = Account.new_account () in
  let {Account.pkh = delegate_pkh; _} = Account.new_account () in
  let contract = Alpha_context.Contract.implicit_contract pkh in
  Op.transaction (I i) bootstrap contract (Tez.of_int 10)
  >>=? fun op ->
  Incremental.add_operation i op
  >>=? fun i ->
  Op.revelation (I i) pk
  >>=? fun op ->
  Incremental.add_operation i op
  >>=? fun i ->
  Op.delegation ~fee (I i) contract (Some delegate_pkh)
  >>=? fun op ->
  Context.Contract.balance (I i) contract
  >>=? fun balance ->
  if fee > balance then
    Incremental.add_operation i op
    >>= fun err ->
    Assert.proto_error ~loc:__LOC__ err (function
        | Contract_storage.Balance_too_low _ ->
            true
        | _ ->
            false)
  else
    (* origination did not proceed; fee has been debited *)
    Incremental.add_operation
      ~expect_failure:(expect_unregistered_key delegate_pkh)
      i
      op
    >>=? fun i ->
    Assert.balance_was_debited ~loc:__LOC__ (I i) contract balance fee

(* self-delegation on revealed and registered contract *)
let registered_self_delegate_key_init_delegation () =
  Context.init 1
  >>=? fun (b, bootstrap_contracts) ->
  Incremental.begin_construction b
  >>=? fun i ->
  let bootstrap = List.hd bootstrap_contracts in
  let {Account.pkh; _} = Account.new_account () in
  let {Account.pkh = delegate_pkh; pk = delegate_pk; _} =
    Account.new_account ()
  in
  let contract = Alpha_context.Contract.implicit_contract pkh in
  let delegate_contract =
    Alpha_context.Contract.implicit_contract delegate_pkh
  in
  Op.transaction (I i) bootstrap contract (Tez.of_int 10)
  >>=? fun op ->
  Incremental.add_operation i op
  >>=? fun i ->
  Op.transaction (I i) bootstrap delegate_contract (Tez.of_int 1)
  >>=? fun op ->
  Incremental.add_operation i op
  >>=? fun i ->
  Op.revelation (I i) delegate_pk
  >>=? fun op ->
  Incremental.add_operation i op
  >>=? fun i ->
  Op.delegation (I i) delegate_contract (Some delegate_pkh)
  >>=? fun op ->
  Incremental.add_operation i op
  >>=? fun i ->
  Op.delegation (I i) contract (Some delegate_pkh)
  >>=? fun op ->
  Incremental.add_operation i op
  >>=? fun i ->
  Context.Contract.delegate (I i) contract
  >>=? fun delegate ->
  Assert.equal_pkh ~loc:__LOC__ delegate delegate_pkh
  >>=? fun () -> return_unit

let tests_delegate_registration =
  [ (*** unregistered delegate key: no self-delegation ***)
    (* no token transfer, no self-delegation *)
    Test.tztest
      "unregistered delegate key (origination, small fee)"
      `Quick
      (unregistered_delegate_key_init_origination ~fee:Tez.one_mutez);
    Test.tztest
      "unregistered delegate key (origination, edge case fee)"
      `Quick
      (unregistered_delegate_key_init_origination ~fee:(Tez.of_int 3_999_488));
    Test.tztest
      "unregistered delegate key (origination, large fee)"
      `Quick
      (unregistered_delegate_key_init_origination ~fee:(Tez.of_int 10_000_000));
    Test.tztest
      "unregistered delegate key (init with delegation, small fee)"
      `Quick
      (unregistered_delegate_key_init_delegation ~fee:Tez.one_mutez);
    Test.tztest
      "unregistered delegate key (init with delegation, max fee)"
      `Quick
      (unregistered_delegate_key_init_delegation ~fee:Tez.max_tez);
    Test.tztest
      "unregistered delegate key (switch with delegation, small fee)"
      `Quick
      (unregistered_delegate_key_switch_delegation ~fee:Tez.one_mutez);
    Test.tztest
      "unregistered delegate key (switch with delegation, max fee)"
      `Quick
      (unregistered_delegate_key_switch_delegation ~fee:Tez.max_tez);
    (* credit/debit 1μꜩ, no self-delegation *)
    Test.tztest
      "unregistered delegate key - credit/debit 1μꜩ (origination, small fee)"
      `Quick
      (unregistered_delegate_key_init_origination_credit_debit
         ~fee:Tez.one_mutez
         ~amount:Tez.one_mutez);
    Test.tztest
      "unregistered delegate key - credit/debit 1μꜩ (origination, large fee)"
      `Quick
      (unregistered_delegate_key_init_origination_credit_debit
         ~fee:Tez.max_tez
         ~amount:Tez.one_mutez);
    Test.tztest
      "unregistered delegate key - credit/debit 1μꜩ (init with delegation, \
       small fee)"
      `Quick
      (unregistered_delegate_key_init_delegation_credit_debit
         ~amount:Tez.one_mutez
         ~fee:Tez.one_mutez);
    Test.tztest
      "unregistered delegate key - credit/debit 1μꜩ (init with delegation, \
       large fee)"
      `Quick
      (unregistered_delegate_key_init_delegation_credit_debit
         ~amount:Tez.one_mutez
         ~fee:Tez.max_tez);
    Test.tztest
      "unregistered delegate key - credit/debit 1μꜩ (switch with \
       delegation, small fee)"
      `Quick
      (unregistered_delegate_key_switch_delegation_credit_debit
         ~amount:Tez.one_mutez
         ~fee:Tez.one_mutez);
    Test.tztest
      "unregistered delegate key - credit/debit 1μꜩ (switch with \
       delegation, large fee)"
      `Quick
      (unregistered_delegate_key_switch_delegation_credit_debit
         ~amount:Tez.one_mutez
         ~fee:Tez.max_tez);
    (* credit 1μꜩ, no self-delegation *)
    Test.tztest
      "unregistered delegate key - credit 1μꜩ (origination, small fee)"
      `Quick
      (unregistered_delegate_key_init_origination_credit
         ~fee:Tez.one_mutez
         ~amount:Tez.one_mutez);
    Test.tztest
      "unregistered delegate key - credit 1μꜩ (origination, edge case fee)"
      `Quick
      (unregistered_delegate_key_init_origination_credit
         ~fee:(Tez.of_int 3_999_488)
         ~amount:Tez.one_mutez);
    Test.tztest
      "unregistered delegate key - credit 1μꜩ (origination, large fee)"
      `Quick
      (unregistered_delegate_key_init_origination_credit
         ~fee:(Tez.of_int 10_000_000)
         ~amount:Tez.one_mutez);
    Test.tztest
      "unregistered delegate key - credit 1μꜩ (init with delegation, small \
       fee)"
      `Quick
      (unregistered_delegate_key_init_delegation_credit
         ~amount:Tez.one_mutez
         ~fee:Tez.one_mutez);
    Test.tztest
      "unregistered delegate key - credit 1μꜩ (init with delegation, large \
       fee)"
      `Quick
      (unregistered_delegate_key_init_delegation_credit
         ~amount:Tez.one_mutez
         ~fee:Tez.max_tez);
    Test.tztest
      "unregistered delegate key - credit 1μꜩ (switch with delegation, \
       small fee)"
      `Quick
      (unregistered_delegate_key_switch_delegation_credit
         ~amount:Tez.one_mutez
         ~fee:Tez.one_mutez);
    Test.tztest
      "unregistered delegate key - credit 1μꜩ (switch with delegation, \
       large fee)"
      `Quick
      (unregistered_delegate_key_switch_delegation_credit
         ~amount:Tez.one_mutez
         ~fee:Tez.max_tez);
    (* self delegation on unrevealed and unregistered contract *)
    Test.tztest
      "unregistered and unrevealed self-delegation (small fee)"
      `Quick
      (unregistered_and_unrevealed_self_delegate_key_init_delegation
         ~fee:Tez.one_mutez);
    Test.tztest
      "unregistered and unrevealed self-delegation (large fee)"
      `Quick
      (unregistered_and_unrevealed_self_delegate_key_init_delegation
         ~fee:Tez.max_tez);
    (* self delegation on unregistered contract *)
    Test.tztest
      "unregistered and revealed self-delegation (small fee)"
      `Quick
      (unregistered_and_revealed_self_delegate_key_init_delegation
         ~fee:Tez.one_mutez);
    Test.tztest
      "unregistered and revealed self-delegation  large fee)"
      `Quick
      (unregistered_and_revealed_self_delegate_key_init_delegation
         ~fee:Tez.max_tez);
    (* self delegation on registered contract *)
    Test.tztest
      "registered and revelead self-delegation"
      `Quick
      registered_self_delegate_key_init_delegation;
    (*** unregistered delegate key: failed self-delegation ***)
    (* no token transfer, self-delegation *)
    Test.tztest
      "failed self-delegation: no transaction"
      `Quick
      failed_self_delegation_no_transaction;
    (* credit 1μtz, debit 1μtz, self-delegation *)
    Test.tztest
      "failed self-delegation: credit & debit 1μꜩ"
      `Quick
      (failed_self_delegation_emptied_implicit_contract Tez.one_mutez);
    (*** valid registration ***)
    (* valid registration: credit 1 μꜩ, self delegation *)
    Test.tztest
      "valid delegate registration: credit 1μꜩ, self delegation (init with \
       delegation)"
      `Quick
      (valid_delegate_registration_init_delegation_credit Tez.one_mutez);
    Test.tztest
      "valid delegate registration: credit 1μꜩ, self delegation (switch \
       with delegation)"
      `Quick
      (valid_delegate_registration_switch_delegation_credit Tez.one_mutez);
    (* valid registration: credit 1 μꜩ, self delegation, debit 1μꜩ *)
    Test.tztest
      "valid delegate registration: credit 1μꜩ, self delegation, debit \
       1μꜩ (init with delegation)"
      `Quick
      (valid_delegate_registration_init_delegation_credit_debit Tez.one_mutez);
    Test.tztest
      "valid delegate registration: credit 1μꜩ, self delegation, debit \
       1μꜩ (switch with delegation)"
      `Quick
      (valid_delegate_registration_switch_delegation_credit_debit Tez.one_mutez);
    (*** double registration ***)
    Test.tztest "double registration" `Quick double_registration;
    Test.tztest
      "double registration when delegate account is emptied"
      `Quick
      double_registration_when_empty;
    Test.tztest
      "double registration when delegate account is emptied and then recredited"
      `Quick
      double_registration_when_recredited ]

(******************************************************************************)
(* Main                                                                       *)
(******************************************************************************)

let tests = tests_bootstrap_contracts @ tests_delegate_registration
delegation_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Protocol.

Import Alpha_context.

Definition expect_error {A B : Type} (err : A) (function_parameter : list B)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  match function_parameter with
  | cons err0 _ => return_unit
  | _ => failwith "Unexpected successful result" % string
  end.

Definition expect_alpha_error {A : Type}
  (err : Tezos_protocol_alpha.Protocol.Environment.Error_monad.error)
  : list A ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  expect_error (Tezos_base__TzPervasives.Error_monad.Ecoproto_error err).

Definition expect_no_change_registered_delegate_pkh {A : Type}
  (pkh : A)
  (function_parameter : list Tezos_base__TzPervasives.Error_monad.error)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  match function_parameter with
  |
    cons
      (Tezos_base__TzPervasives.Error_monad.Ecoproto_error
        (Tezos_protocol_environment_alpha__Environment.Error_monad.No_deletion
          pkh0)) _ => return_unit
  | _ =>
    failwith "Delegate can not be deleted and operation should fail." % string
  end.

Definition bootstrap_manager_is_bootstrap_delegate {A : Type}
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      let bootstrap0 := List.hd bootstrap_contracts in
      op_gtgteqquestion
        (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap0)
        (fun delegate0 =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap0)
            (fun manager0 =>
              op_startypeminuserrorstar __LOC__ delegate0 (pkh manager0)))).

Definition bootstrap_delegate_cannot_change {A B : Type}
  (fee : A) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      let bootstrap0 := op_startypeminuserrorstar bootstrap_contracts 0 in
      let bootstrap1 := op_startypeminuserrorstar bootstrap_contracts 1 in
      op_gtgteqquestion (op_startypeminuserrorstar bootstrap0)
        (fun pkh1 =>
          op_gtgteqquestion
            (op_startypeminuserrorstar b op_startypeminuserrorstar)
            (fun i =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap1)
                (fun manager1 =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      bootstrap0)
                    (fun balance0 =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          bootstrap0)
                        (fun delegate0 =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar fee
                              op_startypeminuserrorstar bootstrap0
                              (Some (pkh manager1)))
                            (fun set_delegate =>
                              if op_startypeminuserrorstar fee balance0 then
                                op_gtgteq
                                  (op_startypeminuserrorstar i set_delegate)
                                  (fun err =>
                                    op_startypeminuserrorstar __LOC__ err
                                      (fun function_parameter =>
                                        match function_parameter with
                                        |
                                          Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                            _ _ _ => true
                                        | _ => false
                                        end))
                              else
                                op_gtgteqquestion
                                  (op_startypeminuserrorstar
                                    (expect_no_change_registered_delegate_pkh
                                      delegate0) i set_delegate)
                                  (fun i =>
                                    op_gtgteqquestion
                                      (op_startypeminuserrorstar i)
                                      (fun b =>
                                        op_gtgteqquestion
                                          (op_startypeminuserrorstar
                                            op_startypeminuserrorstar bootstrap0)
                                          (fun delegate0_after =>
                                            op_gtgteqquestion
                                              (op_startypeminuserrorstar __LOC__
                                                delegate0_after delegate0)
                                              (fun function_parameter =>
                                                let 'tt := function_parameter in
                                                op_startypeminuserrorstar
                                                  __LOC__
                                                  op_startypeminuserrorstar
                                                  bootstrap0 balance0 fee))))))))))).

Definition bootstrap_delegate_cannot_be_removed {A B : Type}
  (fee : A) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      let bootstrap := List.hd bootstrap_contracts in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap)
            (fun balance =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap)
                (fun delegate =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      bootstrap)
                    (fun manager =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar fee op_startypeminuserrorstar
                          bootstrap None)
                        (fun set_delegate =>
                          if op_startypeminuserrorstar fee balance then
                            op_gtgteq (op_startypeminuserrorstar i set_delegate)
                              (fun err =>
                                op_startypeminuserrorstar __LOC__ err
                                  (fun function_parameter =>
                                    match function_parameter with
                                    |
                                      Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                        _ _ _ => true
                                    | _ => false
                                    end))
                          else
                            op_gtgteqquestion
                              (op_startypeminuserrorstar
                                (expect_no_change_registered_delegate_pkh
                                  (pkh manager)) i set_delegate)
                              (fun i =>
                                op_gtgteqquestion
                                  (op_startypeminuserrorstar
                                    op_startypeminuserrorstar bootstrap)
                                  (fun delegate_after =>
                                    op_gtgteqquestion
                                      (op_startypeminuserrorstar __LOC__
                                        delegate delegate_after)
                                      (fun function_parameter =>
                                        let 'tt := function_parameter in
                                        op_startypeminuserrorstar __LOC__
                                          op_startypeminuserrorstar bootstrap
                                          balance fee))))))))).

Definition delegate_can_be_changed_from_unregistered_contract {A B : Type}
  (fee : A) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      let bootstrap0 := List.hd bootstrap_contracts in
      let bootstrap1 := op_startypeminuserrorstar bootstrap_contracts 1 in
      let unregistered_account := op_startypeminuserrorstar tt in
      let unregistered_pkh := op_startypeminuserrorstar in
      let unregistered := Contract.implicit_contract unregistered_pkh in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap0)
            (fun manager0 =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap1)
                (fun manager1 =>
                  let credit := op_startypeminuserrorstar 10 in
                  op_gtgteqquestion
                    (op_startypeminuserrorstar Tez.zero
                      op_startypeminuserrorstar bootstrap0 unregistered credit)
                    (fun credit_contract =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          bootstrap0)
                        (fun balance =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar i credit_contract)
                            (fun i =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar Tez.zero
                                  op_startypeminuserrorstar unregistered
                                  (Some (pkh manager0)))
                                (fun set_delegate =>
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar i set_delegate)
                                    (fun i =>
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar
                                          op_startypeminuserrorstar unregistered)
                                        (fun delegate =>
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar __LOC__
                                              delegate (pkh manager0))
                                            (fun function_parameter =>
                                              let 'tt := function_parameter in
                                              op_gtgteqquestion
                                                (op_startypeminuserrorstar fee
                                                  op_startypeminuserrorstar
                                                  unregistered
                                                  (Some (pkh manager1)))
                                                (fun change_delegate =>
                                                  if
                                                    op_startypeminuserrorstar
                                                      fee balance then
                                                    op_gtgteq
                                                      (op_startypeminuserrorstar
                                                        i change_delegate)
                                                      (fun err =>
                                                        op_startypeminuserrorstar
                                                          __LOC__ err
                                                          (fun
                                                            function_parameter
                                                            =>
                                                            match
                                                              function_parameter
                                                              with
                                                            |
                                                              Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                                                _ _ _ => true
                                                            | _ => false
                                                            end))
                                                  else
                                                    op_gtgteqquestion
                                                      (op_startypeminuserrorstar
                                                        i change_delegate)
                                                      (fun i =>
                                                        op_gtgteqquestion
                                                          (op_startypeminuserrorstar
                                                            op_startypeminuserrorstar
                                                            unregistered)
                                                          (fun delegate_after =>
                                                            op_gtgteqquestion
                                                              (op_startypeminuserrorstar
                                                                __LOC__
                                                                delegate_after
                                                                (pkh manager1))
                                                              (fun
                                                                function_parameter
                                                                =>
                                                                let 'tt :=
                                                                  function_parameter
                                                                  in
                                                                op_startypeminuserrorstar
                                                                  __LOC__
                                                                  op_startypeminuserrorstar
                                                                  unregistered
                                                                  credit fee))))))))))))))).

Definition delegate_can_be_removed_from_unregistered_contract {A B : Type}
  (fee : A) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      let bootstrap := List.hd bootstrap_contracts in
      let unregistered_account := op_startypeminuserrorstar tt in
      let unregistered_pkh := op_startypeminuserrorstar in
      let unregistered := Contract.implicit_contract unregistered_pkh in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap)
            (fun manager =>
              let credit := op_startypeminuserrorstar 10 in
              op_gtgteqquestion
                (op_startypeminuserrorstar Tez.zero op_startypeminuserrorstar
                  bootstrap unregistered credit)
                (fun credit_contract =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      bootstrap)
                    (fun balance =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar i credit_contract)
                        (fun i =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar Tez.zero
                              op_startypeminuserrorstar unregistered
                              (Some (pkh manager)))
                            (fun set_delegate =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar i set_delegate)
                                (fun i =>
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar
                                      op_startypeminuserrorstar unregistered)
                                    (fun delegate =>
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar __LOC__
                                          delegate (pkh manager))
                                        (fun function_parameter =>
                                          let 'tt := function_parameter in
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar fee
                                              op_startypeminuserrorstar
                                              unregistered None)
                                            (fun delete_delegate =>
                                              if
                                                op_startypeminuserrorstar fee
                                                  balance then
                                                op_gtgteq
                                                  (op_startypeminuserrorstar i
                                                    delete_delegate)
                                                  (fun err =>
                                                    op_startypeminuserrorstar
                                                      __LOC__ err
                                                      (fun function_parameter =>
                                                        match function_parameter
                                                          with
                                                        |
                                                          Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                                            _ _ _ => true
                                                        | _ => false
                                                        end))
                                              else
                                                op_gtgteqquestion
                                                  (op_startypeminuserrorstar i
                                                    delete_delegate)
                                                  (fun i =>
                                                    op_gtgteqquestion
                                                      (op_gtgteqquestion
                                                        (op_startypeminuserrorstar
                                                          op_startypeminuserrorstar
                                                          unregistered)
                                                        (fun function_parameter
                                                          =>
                                                          match
                                                            function_parameter
                                                            with
                                                          | None => return_unit
                                                          | Some _ =>
                                                            failwith
                                                              "Expected delegate to be removed"
                                                                % string
                                                          end))
                                                      (fun function_parameter =>
                                                        let 'tt :=
                                                          function_parameter in
                                                        op_startypeminuserrorstar
                                                          __LOC__
                                                          op_startypeminuserrorstar
                                                          unregistered credit
                                                          fee))))))))))))).

Definition bootstrap_manager_already_registered_delegate {A B : Type}
  (fee : A) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap)
            (fun manager =>
              let pkh := pkh manager in
              let impl_contract := Contract.implicit_contract pkh in
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar
                  impl_contract)
                (fun balance =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar fee op_startypeminuserrorstar
                      impl_contract (Some pkh))
                    (fun sec_reg =>
                      if op_startypeminuserrorstar fee balance then
                        op_gtgteq (op_startypeminuserrorstar i sec_reg)
                          (fun err =>
                            op_startypeminuserrorstar __LOC__ err
                              (fun function_parameter =>
                                match function_parameter with
                                |
                                  Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                    _ _ _ => true
                                | _ => false
                                end))
                      else
                        op_gtgteqquestion
                          (op_startypeminuserrorstar
                            (fun function_parameter =>
                              match function_parameter with
                              |
                                cons
                                  (Tezos_base__TzPervasives.Error_monad.Ecoproto_error
                                    Tezos_protocol_environment_alpha__Environment.Error_monad.Active_delegate)
                                  _ => return_unit
                              | _ =>
                                failwith
                                  "Delegate is already active and operation should fail."
                                    % string
                              end) i sec_reg)
                          (fun i =>
                            op_startypeminuserrorstar __LOC__
                              op_startypeminuserrorstar impl_contract balance
                              fee)))))).

Definition delegate_to_bootstrap_by_origination {A : Type}
  (fee : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez)
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap)
            (fun manager =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap)
                (fun balance =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar fee Tez.zero (pkh manager)
                      op_startypeminuserrorstar bootstrap
                      op_startypeminuserrorstar)
                    (fun function_parameter =>
                      let '(op, orig_contract) := function_parameter in
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar)
                        (fun function_parameter =>
                          let '_ := function_parameter in
                          op_startypeminuserrorstar
                            (op_starquestion op_startypeminuserrorstar
                              (Int64.of_int op_startypeminuserrorstar))
                            (fun origination_burn =>
                              op_gtgteqquestion
                                (Lwt.__return
                                  (op_gtgtquestion
                                    (Tez.op_plusquestion fee origination_burn)
                                    (Tez.op_plusquestion
                                      op_startypeminuserrorstar)))
                                (fun total_fee =>
                                  if op_startypeminuserrorstar fee balance then
                                    op_gtgteq (op_startypeminuserrorstar i op)
                                      (fun err =>
                                        op_startypeminuserrorstar __LOC__ err
                                          (fun function_parameter =>
                                            match function_parameter with
                                            |
                                              Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                                _ _ _ => true
                                            | _ => false
                                            end))
                                  else
                                    if
                                      op_andand
                                        (op_startypeminuserrorstar total_fee
                                          balance)
                                        (op_startypeminuserrorstar balance fee)
                                      then
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar i
                                          (fun function_parameter =>
                                            match function_parameter with
                                            |
                                              cons
                                                (Tezos_base__TzPervasives.Error_monad.Ecoproto_error
                                                  (Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                                    _ _ _)) _ => return_unit
                                            | _ =>
                                              failwith
                                                "Not enough balance for origination burn: operation should fail."
                                                  % string
                                            end) op)
                                        (fun i =>
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar __LOC__
                                              op_startypeminuserrorstar
                                              bootstrap balance fee)
                                            (fun function_parameter =>
                                              let 'tt := function_parameter in
                                              op_gtgteq
                                                (op_startypeminuserrorstar
                                                  op_startypeminuserrorstar
                                                  orig_contract)
                                                (fun err =>
                                                  op_startypeminuserrorstar
                                                    __LOC__ err
                                                    (fun function_parameter =>
                                                      match function_parameter
                                                        with
                                                      | _ => true
                                                      | _ => false
                                                      end))))
                                    else
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar i op)
                                        (fun i =>
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar
                                              op_startypeminuserrorstar
                                              orig_contract)
                                            (fun delegate =>
                                              op_gtgteqquestion
                                                (op_startypeminuserrorstar
                                                  __LOC__ delegate (pkh manager))
                                                (fun function_parameter =>
                                                  let 'tt := function_parameter
                                                    in
                                                  op_startypeminuserrorstar
                                                    __LOC__
                                                    op_startypeminuserrorstar
                                                    bootstrap balance total_fee))))))))))).

Definition tests_bootstrap_contracts {A : Type} : list A :=
  cons
    (op_startypeminuserrorstar
      "bootstrap contracts delegate to themselves" % string
      (* ❌ Variants not supported *)
      variant bootstrap_manager_is_bootstrap_delegate)
    (cons
      (op_startypeminuserrorstar
        "bootstrap contracts can change their delegate (small fee)" % string
        (* ❌ Variants not supported *)
        variant (bootstrap_delegate_cannot_change Tez.one_mutez))
      (cons
        (op_startypeminuserrorstar
          "bootstrap contracts can change their delegate (max fee)" % string
          (* ❌ Variants not supported *)
          variant (bootstrap_delegate_cannot_change op_startypeminuserrorstar))
        (cons
          (op_startypeminuserrorstar
            "bootstrap contracts cannot remove their delegation (small fee)" %
              string
            (* ❌ Variants not supported *)
            variant (bootstrap_delegate_cannot_be_removed Tez.one_mutez))
          (cons
            (op_startypeminuserrorstar
              "bootstrap contracts cannot remove their delegation (max fee)" %
                string
              (* ❌ Variants not supported *)
              variant
              (bootstrap_delegate_cannot_be_removed op_startypeminuserrorstar))
            (cons
              (op_startypeminuserrorstar
                "contracts not registered as delegate can remove their delegation (small fee)"
                  % string
                (* ❌ Variants not supported *)
                variant
                (delegate_can_be_changed_from_unregistered_contract
                  Tez.one_mutez))
              (cons
                (op_startypeminuserrorstar
                  "contracts not registered as delegate can remove their delegation (max fee)"
                    % string
                  (* ❌ Variants not supported *)
                  variant
                  (delegate_can_be_changed_from_unregistered_contract
                    op_startypeminuserrorstar))
                (cons
                  (op_startypeminuserrorstar
                    "contracts not registered as delegate can remove their delegation (small fee)"
                      % string
                    (* ❌ Variants not supported *)
                    variant
                    (delegate_can_be_removed_from_unregistered_contract
                      Tez.one_mutez))
                  (cons
                    (op_startypeminuserrorstar
                      "contracts not registered as delegate can remove their delegation (max fee)"
                        % string
                      (* ❌ Variants not supported *)
                      variant
                      (delegate_can_be_removed_from_unregistered_contract
                        op_startypeminuserrorstar))
                    (cons
                      (op_startypeminuserrorstar
                        "bootstrap keys are already registered as delegate keys (small fee)"
                          % string
                        (* ❌ Variants not supported *)
                        variant
                        (bootstrap_manager_already_registered_delegate
                          Tez.one_mutez))
                      (cons
                        (op_startypeminuserrorstar
                          "bootstrap keys are already registered as delegate keys (max fee)"
                            % string
                          (* ❌ Variants not supported *)
                          variant
                          (bootstrap_manager_already_registered_delegate
                            op_startypeminuserrorstar))
                        (cons
                          (op_startypeminuserrorstar
                            "bootstrap manager can be delegate (init origination, small fee)"
                              % string
                            (* ❌ Variants not supported *)
                            variant
                            (delegate_to_bootstrap_by_origination Tez.one_mutez))
                          (cons
                            (op_startypeminuserrorstar
                              "bootstrap manager can be delegate (init origination, edge case)"
                                % string
                              (* ❌ Variants not supported *)
                              variant
                              (delegate_to_bootstrap_by_origination
                                (op_startypeminuserrorstar
                                  (* ❌ Constant of type int64 is converted to int *)
                                  3999999705000)))
                            (cons
                              (op_startypeminuserrorstar
                                "bootstrap manager can be delegate (init origination, large fee)"
                                  % string
                                (* ❌ Variants not supported *)
                                variant
                                (delegate_to_bootstrap_by_origination
                                  (op_startypeminuserrorstar 10000000))) []))))))))))))).

Definition expect_unregistered_key {A : Type}
  (pkh : A)
  (function_parameter : list Tezos_base__TzPervasives.Error_monad.error)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  match function_parameter with
  |
    cons
      (Tezos_base__TzPervasives.Error_monad.Ecoproto_error
        (Tezos_protocol_environment_alpha__Environment.Error_monad.Unregistered_delegate
          pkh0)) _ => return_unit
  | _ =>
    failwith "Delegate key is not registered: operation should fail." % string
  end.

Definition unregistered_delegate_key_init_origination {A : Type}
  (fee : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez)
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          let unregistered_account := op_startypeminuserrorstar tt in
          let unregistered_pkh := op_startypeminuserrorstar in
          op_gtgteqquestion
            (op_startypeminuserrorstar fee unregistered_pkh
              op_startypeminuserrorstar bootstrap op_startypeminuserrorstar)
            (fun function_parameter =>
              let '(op, orig_contract) := function_parameter in
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar)
                (fun function_parameter =>
                  let '_ := function_parameter in
                  op_startypeminuserrorstar
                    (op_starquestion op_startypeminuserrorstar
                      (Int64.of_int op_startypeminuserrorstar))
                    (fun origination_burn =>
                      op_gtgteqquestion
                        (Lwt.__return (Tez.op_plusquestion fee origination_burn))
                        (fun _total_fee =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar op_startypeminuserrorstar
                              bootstrap)
                            (fun balance =>
                              if op_startypeminuserrorstar fee balance then
                                op_gtgteq (op_startypeminuserrorstar i op)
                                  (fun err =>
                                    op_startypeminuserrorstar __LOC__ err
                                      (fun function_parameter =>
                                        match function_parameter with
                                        |
                                          Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                            _ _ _ => true
                                        | _ => false
                                        end))
                              else
                                op_gtgteqquestion
                                  (op_startypeminuserrorstar
                                    (expect_unregistered_key unregistered_pkh) i
                                    op)
                                  (fun i =>
                                    op_gtgteqquestion
                                      (op_startypeminuserrorstar __LOC__
                                        op_startypeminuserrorstar bootstrap
                                        balance fee)
                                      (fun function_parameter =>
                                        let 'tt := function_parameter in
                                        op_gtgteq
                                          (op_startypeminuserrorstar
                                            op_startypeminuserrorstar
                                            orig_contract)
                                          (fun err =>
                                            op_startypeminuserrorstar __LOC__
                                              err
                                              (fun function_parameter =>
                                                match function_parameter with
                                                | _ => true
                                                | _ => false
                                                end))))))))))).

Definition unregistered_delegate_key_init_delegation {A B : Type}
  (fee : A) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          let unregistered_account := op_startypeminuserrorstar tt in
          let unregistered_pkh := op_startypeminuserrorstar in
          let impl_contract := Contract.implicit_contract unregistered_pkh in
          let unregistered_delegate_account := op_startypeminuserrorstar tt in
          let unregistered_delegate_pkh := op_startypeminuserrorstar in
          let credit := op_startypeminuserrorstar 10 in
          op_gtgteqquestion
            (op_startypeminuserrorstar Tez.zero op_startypeminuserrorstar
              bootstrap impl_contract credit)
            (fun credit_contract =>
              op_gtgteqquestion (op_startypeminuserrorstar i credit_contract)
                (fun i =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar __LOC__ op_startypeminuserrorstar
                      impl_contract credit)
                    (fun function_parameter =>
                      let '_ := function_parameter in
                      op_gtgteqquestion
                        (op_startypeminuserrorstar fee op_startypeminuserrorstar
                          impl_contract (Some unregistered_delegate_pkh))
                        (fun delegate_op =>
                          if op_startypeminuserrorstar fee credit then
                            op_gtgteq (op_startypeminuserrorstar i delegate_op)
                              (fun err =>
                                op_startypeminuserrorstar __LOC__ err
                                  (fun function_parameter =>
                                    match function_parameter with
                                    |
                                      Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                        _ _ _ => true
                                    | _ => false
                                    end))
                          else
                            op_gtgteqquestion
                              (op_startypeminuserrorstar i
                                (expect_unregistered_key
                                  unregistered_delegate_pkh) delegate_op)
                              (fun i =>
                                op_gtgteqquestion
                                  (op_startypeminuserrorstar __LOC__
                                    op_startypeminuserrorstar impl_contract
                                    credit fee)
                                  (fun function_parameter =>
                                    let 'tt := function_parameter in
                                    op_gtgteq
                                      (op_startypeminuserrorstar
                                        op_startypeminuserrorstar impl_contract)
                                      (fun err =>
                                        op_startypeminuserrorstar __LOC__ err
                                          (fun function_parameter =>
                                            match function_parameter with
                                            | _ => true
                                            | _ => false
                                            end)))))))))).

Definition unregistered_delegate_key_switch_delegation {A B : Type}
  (fee : A) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          let bootstrap_pkh :=
            op_pipegt (Contract.is_implicit bootstrap)
              (op_startypeminuserrorstar __POS__) in
          let unregistered_account := op_startypeminuserrorstar tt in
          let unregistered_pkh := op_startypeminuserrorstar in
          let impl_contract := Contract.implicit_contract unregistered_pkh in
          let unregistered_delegate_account := op_startypeminuserrorstar tt in
          let unregistered_delegate_pkh := op_startypeminuserrorstar in
          let credit := op_startypeminuserrorstar 10 in
          op_gtgteqquestion
            (op_startypeminuserrorstar Tez.zero op_startypeminuserrorstar
              bootstrap impl_contract credit)
            (fun init_credit =>
              op_gtgteqquestion (op_startypeminuserrorstar i init_credit)
                (fun i =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar __LOC__ op_startypeminuserrorstar
                      impl_contract credit)
                    (fun function_parameter =>
                      let '_ := function_parameter in
                      op_gtgteqquestion
                        (op_startypeminuserrorstar Tez.zero
                          op_startypeminuserrorstar impl_contract
                          (Some bootstrap_pkh))
                        (fun delegate_op =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar i delegate_op)
                            (fun i =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar
                                  op_startypeminuserrorstar bootstrap)
                                (fun delegate_pkh =>
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar __LOC__
                                      bootstrap_pkh delegate_pkh)
                                    (fun function_parameter =>
                                      let 'tt := function_parameter in
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar fee
                                          op_startypeminuserrorstar
                                          impl_contract
                                          (Some unregistered_delegate_pkh))
                                        (fun delegate_op =>
                                          if
                                            op_startypeminuserrorstar fee credit
                                            then
                                            op_gtgteq
                                              (op_startypeminuserrorstar i
                                                delegate_op)
                                              (fun err =>
                                                op_startypeminuserrorstar
                                                  __LOC__ err
                                                  (fun function_parameter =>
                                                    match function_parameter
                                                      with
                                                    |
                                                      Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                                        _ _ _ => true
                                                    | _ => false
                                                    end))
                                          else
                                            op_gtgteqquestion
                                              (op_startypeminuserrorstar i
                                                (expect_unregistered_key
                                                  unregistered_delegate_pkh)
                                                delegate_op)
                                              (fun i =>
                                                op_gtgteqquestion
                                                  (op_startypeminuserrorstar
                                                    __LOC__
                                                    op_startypeminuserrorstar
                                                    impl_contract credit fee)
                                                  (fun function_parameter =>
                                                    let 'tt :=
                                                      function_parameter in
                                                    op_gtgteqquestion
                                                      (op_startypeminuserrorstar
                                                        op_startypeminuserrorstar
                                                        bootstrap)
                                                      (fun delegate_pkh_after =>
                                                        op_startypeminuserrorstar
                                                          __LOC__ delegate_pkh
                                                          delegate_pkh_after))))))))))))).

Definition unregistered_delegate_key_init_origination_credit {A B C : Type}
  (fee : A) (amount : B) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult C) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          let unregistered_account := op_startypeminuserrorstar tt in
          let unregistered_pkh := op_startypeminuserrorstar in
          let impl_contract := Contract.implicit_contract unregistered_pkh in
          op_gtgteqquestion
            (op_startypeminuserrorstar Tez.zero op_startypeminuserrorstar
              bootstrap impl_contract amount)
            (fun create_contract =>
              op_gtgteqquestion (op_startypeminuserrorstar i create_contract)
                (fun i =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar __LOC__ op_startypeminuserrorstar
                      impl_contract amount)
                    (fun function_parameter =>
                      let '_ := function_parameter in
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          bootstrap)
                        (fun balance =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar fee unregistered_pkh
                              op_startypeminuserrorstar bootstrap
                              op_startypeminuserrorstar)
                            (fun function_parameter =>
                              let '(op, orig_contract) := function_parameter in
                              if op_startypeminuserrorstar fee balance then
                                op_gtgteq (op_startypeminuserrorstar i op)
                                  (fun err =>
                                    op_startypeminuserrorstar __LOC__ err
                                      (fun function_parameter =>
                                        match function_parameter with
                                        |
                                          Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                            _ _ _ => true
                                        | _ => false
                                        end))
                              else
                                op_gtgteqquestion
                                  (op_startypeminuserrorstar
                                    (expect_unregistered_key unregistered_pkh) i
                                    op)
                                  (fun i =>
                                    op_gtgteqquestion
                                      (op_startypeminuserrorstar __LOC__
                                        op_startypeminuserrorstar bootstrap
                                        balance fee)
                                      (fun function_parameter =>
                                        let 'tt := function_parameter in
                                        op_gtgteq
                                          (op_startypeminuserrorstar
                                            op_startypeminuserrorstar
                                            orig_contract)
                                          (fun err =>
                                            op_startypeminuserrorstar __LOC__
                                              err
                                              (fun function_parameter =>
                                                match function_parameter with
                                                | _ => true
                                                | _ => false
                                                end))))))))))).

Definition unregistered_delegate_key_init_delegation_credit {A B : Type}
  (fee : A) (amount : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez)
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          let unregistered_account := op_startypeminuserrorstar tt in
          let unregistered_pkh := op_startypeminuserrorstar in
          let impl_contract := Contract.implicit_contract unregistered_pkh in
          let unregistered_delegate_account := op_startypeminuserrorstar tt in
          let unregistered_delegate_pkh := op_startypeminuserrorstar in
          op_gtgteqquestion
            (op_startypeminuserrorstar Tez.zero op_startypeminuserrorstar
              bootstrap impl_contract amount)
            (fun create_contract =>
              op_gtgteqquestion (op_startypeminuserrorstar i create_contract)
                (fun i =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar __LOC__ op_startypeminuserrorstar
                      impl_contract amount)
                    (fun function_parameter =>
                      let '_ := function_parameter in
                      let credit := op_startypeminuserrorstar 10 in
                      op_gtgteqquestion
                        (Lwt.__return (op_plusquestion credit amount))
                        (fun balance =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar Tez.zero
                              op_startypeminuserrorstar bootstrap impl_contract
                              credit)
                            (fun init_credit =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar i init_credit)
                                (fun i =>
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar __LOC__
                                      op_startypeminuserrorstar impl_contract
                                      balance)
                                    (fun function_parameter =>
                                      let '_ := function_parameter in
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar fee
                                          op_startypeminuserrorstar
                                          impl_contract
                                          (Some unregistered_delegate_pkh))
                                        (fun delegate_op =>
                                          if
                                            op_startypeminuserrorstar fee credit
                                            then
                                            op_gtgteq
                                              (op_startypeminuserrorstar i
                                                delegate_op)
                                              (fun err =>
                                                op_startypeminuserrorstar
                                                  __LOC__ err
                                                  (fun function_parameter =>
                                                    match function_parameter
                                                      with
                                                    |
                                                      Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                                        _ _ _ => true
                                                    | _ => false
                                                    end))
                                          else
                                            op_gtgteqquestion
                                              (op_startypeminuserrorstar
                                                (expect_unregistered_key
                                                  unregistered_delegate_pkh) i
                                                delegate_op)
                                              (fun i =>
                                                op_gtgteqquestion
                                                  (op_startypeminuserrorstar
                                                    __LOC__
                                                    op_startypeminuserrorstar
                                                    impl_contract balance fee)
                                                  (fun function_parameter =>
                                                    let 'tt :=
                                                      function_parameter in
                                                    op_gtgteq
                                                      (op_startypeminuserrorstar
                                                        op_startypeminuserrorstar
                                                        impl_contract)
                                                      (fun err =>
                                                        op_startypeminuserrorstar
                                                          __LOC__ err
                                                          (fun
                                                            function_parameter
                                                            =>
                                                            match
                                                              function_parameter
                                                              with
                                                            | _ => true
                                                            | _ => false
                                                            end)))))))))))))).

Definition unregistered_delegate_key_switch_delegation_credit {A B : Type}
  (fee : A) (amount : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez)
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          let bootstrap_pkh :=
            op_pipegt (Contract.is_implicit bootstrap)
              (op_startypeminuserrorstar __POS__) in
          let unregistered_account := op_startypeminuserrorstar tt in
          let unregistered_pkh := op_startypeminuserrorstar in
          let impl_contract := Contract.implicit_contract unregistered_pkh in
          let unregistered_delegate_account := op_startypeminuserrorstar tt in
          let unregistered_delegate_pkh := op_startypeminuserrorstar in
          op_gtgteqquestion
            (op_startypeminuserrorstar Tez.zero op_startypeminuserrorstar
              bootstrap impl_contract amount)
            (fun create_contract =>
              op_gtgteqquestion (op_startypeminuserrorstar i create_contract)
                (fun i =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar __LOC__ op_startypeminuserrorstar
                      impl_contract amount)
                    (fun function_parameter =>
                      let '_ := function_parameter in
                      let credit := op_startypeminuserrorstar 10 in
                      op_gtgteqquestion
                        (Lwt.__return (op_plusquestion credit amount))
                        (fun balance =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar Tez.zero
                              op_startypeminuserrorstar bootstrap impl_contract
                              credit)
                            (fun init_credit =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar i init_credit)
                                (fun i =>
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar __LOC__
                                      op_startypeminuserrorstar impl_contract
                                      balance)
                                    (fun function_parameter =>
                                      let '_ := function_parameter in
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar Tez.zero
                                          op_startypeminuserrorstar
                                          impl_contract (Some bootstrap_pkh))
                                        (fun delegate_op =>
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar i
                                              delegate_op)
                                            (fun i =>
                                              op_gtgteqquestion
                                                (op_startypeminuserrorstar
                                                  op_startypeminuserrorstar
                                                  bootstrap)
                                                (fun delegate_pkh =>
                                                  op_gtgteqquestion
                                                    (op_startypeminuserrorstar
                                                      __LOC__ bootstrap_pkh
                                                      delegate_pkh)
                                                    (fun function_parameter =>
                                                      let 'tt :=
                                                        function_parameter in
                                                      op_gtgteqquestion
                                                        (op_startypeminuserrorstar
                                                          fee
                                                          op_startypeminuserrorstar
                                                          impl_contract
                                                          (Some
                                                            unregistered_delegate_pkh))
                                                        (fun delegate_op =>
                                                          if
                                                            op_startypeminuserrorstar
                                                              fee credit then
                                                            op_gtgteq
                                                              (op_startypeminuserrorstar
                                                                i delegate_op)
                                                              (fun err =>
                                                                op_startypeminuserrorstar
                                                                  __LOC__ err
                                                                  (fun
                                                                    function_parameter
                                                                    =>
                                                                    match
                                                                      function_parameter
                                                                      with
                                                                    |
                                                                      Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                                                        _ _ _ =>
                                                                      true
                                                                    | _ => false
                                                                    end))
                                                          else
                                                            op_gtgteqquestion
                                                              (op_startypeminuserrorstar
                                                                (expect_unregistered_key
                                                                  unregistered_delegate_pkh)
                                                                i delegate_op)
                                                              (fun i =>
                                                                op_gtgteqquestion
                                                                  (op_startypeminuserrorstar
                                                                    __LOC__
                                                                    op_startypeminuserrorstar
                                                                    impl_contract
                                                                    balance fee)
                                                                  (fun
                                                                    function_parameter
                                                                    =>
                                                                    let 'tt :=
                                                                      function_parameter
                                                                      in
                                                                    op_gtgteqquestion
                                                                      (op_startypeminuserrorstar
                                                                        op_startypeminuserrorstar
                                                                        impl_contract)
                                                                      (fun
                                                                        delegate
                                                                        =>
                                                                        op_gtgteqquestion
                                                                          (op_startypeminuserrorstar
                                                                            __LOC__
                                                                            delegate
                                                                            unregistered_delegate_pkh)
                                                                          (fun
                                                                            function_parameter
                                                                            =>
                                                                            let
                                                                              'tt :=
                                                                              function_parameter
                                                                              in
                                                                            op_startypeminuserrorstar
                                                                              __LOC__
                                                                              delegate
                                                                              bootstrap_pkh)))))))))))))))))).

Definition unregistered_delegate_key_init_origination_credit_debit
  {A B C : Type} (fee : A) (amount : B) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult C) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          let unregistered_account := op_startypeminuserrorstar tt in
          let unregistered_pkh := op_startypeminuserrorstar in
          let impl_contract := Contract.implicit_contract unregistered_pkh in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap
              impl_contract amount)
            (fun create_contract =>
              op_gtgteqquestion (op_startypeminuserrorstar i create_contract)
                (fun i =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar __LOC__ op_startypeminuserrorstar
                      impl_contract amount)
                    (fun function_parameter =>
                      let '_ := function_parameter in
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          impl_contract bootstrap amount)
                        (fun debit_contract =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar i debit_contract)
                            (fun i =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar __LOC__
                                  op_startypeminuserrorstar impl_contract
                                  Tez.zero)
                                (fun function_parameter =>
                                  let '_ := function_parameter in
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar
                                      op_startypeminuserrorstar bootstrap)
                                    (fun balance =>
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar fee
                                          unregistered_pkh
                                          op_startypeminuserrorstar bootstrap
                                          op_startypeminuserrorstar)
                                        (fun function_parameter =>
                                          let '(op, orig_contract) :=
                                            function_parameter in
                                          if
                                            op_startypeminuserrorstar fee
                                              balance then
                                            op_gtgteq
                                              (op_startypeminuserrorstar i op)
                                              (fun err =>
                                                op_startypeminuserrorstar
                                                  __LOC__ err
                                                  (fun function_parameter =>
                                                    match function_parameter
                                                      with
                                                    |
                                                      Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                                        _ _ _ => true
                                                    | _ => false
                                                    end))
                                          else
                                            op_gtgteqquestion
                                              (op_startypeminuserrorstar
                                                (expect_unregistered_key
                                                  unregistered_pkh) i op)
                                              (fun i =>
                                                op_gtgteqquestion
                                                  (op_startypeminuserrorstar
                                                    __LOC__
                                                    op_startypeminuserrorstar
                                                    bootstrap balance fee)
                                                  (fun function_parameter =>
                                                    let 'tt :=
                                                      function_parameter in
                                                    op_gtgteq
                                                      (op_startypeminuserrorstar
                                                        op_startypeminuserrorstar
                                                        orig_contract)
                                                      (fun err =>
                                                        op_startypeminuserrorstar
                                                          __LOC__ err
                                                          (fun
                                                            function_parameter
                                                            =>
                                                            match
                                                              function_parameter
                                                              with
                                                            | _ => true
                                                            | _ => false
                                                            end)))))))))))))).

Definition unregistered_delegate_key_init_delegation_credit_debit {A B C : Type}
  (amount : A) (fee : B) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult C) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          let unregistered_account := op_startypeminuserrorstar tt in
          let unregistered_pkh := op_startypeminuserrorstar in
          let impl_contract := Contract.implicit_contract unregistered_pkh in
          let unregistered_delegate_account := op_startypeminuserrorstar tt in
          let unregistered_delegate_pkh := op_startypeminuserrorstar in
          op_gtgteqquestion
            (op_startypeminuserrorstar Tez.zero op_startypeminuserrorstar
              bootstrap impl_contract amount)
            (fun create_contract =>
              op_gtgteqquestion (op_startypeminuserrorstar i create_contract)
                (fun i =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar __LOC__ op_startypeminuserrorstar
                      impl_contract amount)
                    (fun function_parameter =>
                      let '_ := function_parameter in
                      op_gtgteqquestion
                        (op_startypeminuserrorstar Tez.zero
                          op_startypeminuserrorstar impl_contract bootstrap
                          amount)
                        (fun debit_contract =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar i debit_contract)
                            (fun i =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar __LOC__
                                  op_startypeminuserrorstar impl_contract
                                  Tez.zero)
                                (fun function_parameter =>
                                  let '_ := function_parameter in
                                  let credit := op_startypeminuserrorstar 10 in
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar Tez.zero
                                      op_startypeminuserrorstar bootstrap
                                      impl_contract credit)
                                    (fun credit_contract =>
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar i
                                          credit_contract)
                                        (fun i =>
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar __LOC__
                                              op_startypeminuserrorstar
                                              impl_contract credit)
                                            (fun function_parameter =>
                                              let '_ := function_parameter in
                                              op_gtgteqquestion
                                                (op_startypeminuserrorstar fee
                                                  op_startypeminuserrorstar
                                                  impl_contract
                                                  (Some
                                                    unregistered_delegate_pkh))
                                                (fun delegate_op =>
                                                  if
                                                    op_startypeminuserrorstar
                                                      fee credit then
                                                    op_gtgteq
                                                      (op_startypeminuserrorstar
                                                        i delegate_op)
                                                      (fun err =>
                                                        op_startypeminuserrorstar
                                                          __LOC__ err
                                                          (fun
                                                            function_parameter
                                                            =>
                                                            match
                                                              function_parameter
                                                              with
                                                            |
                                                              Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                                                _ _ _ => true
                                                            | _ => false
                                                            end))
                                                  else
                                                    op_gtgteqquestion
                                                      (op_startypeminuserrorstar
                                                        (expect_unregistered_key
                                                          unregistered_delegate_pkh)
                                                        i delegate_op)
                                                      (fun i =>
                                                        op_gtgteqquestion
                                                          (op_startypeminuserrorstar
                                                            __LOC__
                                                            op_startypeminuserrorstar
                                                            impl_contract credit
                                                            fee)
                                                          (fun
                                                            function_parameter
                                                            =>
                                                            let 'tt :=
                                                              function_parameter
                                                              in
                                                            op_gtgteq
                                                              (op_startypeminuserrorstar
                                                                op_startypeminuserrorstar
                                                                impl_contract)
                                                              (fun err =>
                                                                op_startypeminuserrorstar
                                                                  __LOC__ err
                                                                  (fun
                                                                    function_parameter
                                                                    =>
                                                                    match
                                                                      function_parameter
                                                                      with
                                                                    | _ => true
                                                                    | _ => false
                                                                    end)))))))))))))))).

Definition unregistered_delegate_key_switch_delegation_credit_debit
  {A B C : Type} (fee : A) (amount : B) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult C) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          let bootstrap_pkh :=
            op_pipegt (Contract.is_implicit bootstrap)
              (op_startypeminuserrorstar __POS__) in
          let unregistered_account := op_startypeminuserrorstar tt in
          let unregistered_pkh := op_startypeminuserrorstar in
          let impl_contract := Contract.implicit_contract unregistered_pkh in
          let unregistered_delegate_account := op_startypeminuserrorstar tt in
          let unregistered_delegate_pkh := op_startypeminuserrorstar in
          op_gtgteqquestion
            (op_startypeminuserrorstar Tez.zero op_startypeminuserrorstar
              bootstrap impl_contract amount)
            (fun create_contract =>
              op_gtgteqquestion (op_startypeminuserrorstar i create_contract)
                (fun i =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar __LOC__ op_startypeminuserrorstar
                      impl_contract amount)
                    (fun function_parameter =>
                      let '_ := function_parameter in
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          impl_contract bootstrap amount)
                        (fun debit_contract =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar i debit_contract)
                            (fun i =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar __LOC__
                                  op_startypeminuserrorstar impl_contract
                                  Tez.zero)
                                (fun function_parameter =>
                                  let '_ := function_parameter in
                                  let credit := op_startypeminuserrorstar 10 in
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar Tez.zero
                                      op_startypeminuserrorstar bootstrap
                                      impl_contract credit)
                                    (fun credit_contract =>
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar i
                                          credit_contract)
                                        (fun i =>
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar __LOC__
                                              op_startypeminuserrorstar
                                              impl_contract credit)
                                            (fun function_parameter =>
                                              let '_ := function_parameter in
                                              op_gtgteqquestion
                                                (op_startypeminuserrorstar
                                                  Tez.zero
                                                  op_startypeminuserrorstar
                                                  impl_contract
                                                  (Some bootstrap_pkh))
                                                (fun delegate_op =>
                                                  op_gtgteqquestion
                                                    (op_startypeminuserrorstar i
                                                      delegate_op)
                                                    (fun i =>
                                                      op_gtgteqquestion
                                                        (op_startypeminuserrorstar
                                                          op_startypeminuserrorstar
                                                          bootstrap)
                                                        (fun delegate_pkh =>
                                                          op_gtgteqquestion
                                                            (op_startypeminuserrorstar
                                                              __LOC__
                                                              bootstrap_pkh
                                                              delegate_pkh)
                                                            (fun
                                                              function_parameter
                                                              =>
                                                              let 'tt :=
                                                                function_parameter
                                                                in
                                                              op_gtgteqquestion
                                                                (op_startypeminuserrorstar
                                                                  op_startypeminuserrorstar
                                                                  fee
                                                                  impl_contract
                                                                  (Some
                                                                    unregistered_delegate_pkh))
                                                                (fun delegate_op
                                                                  =>
                                                                  if
                                                                    op_startypeminuserrorstar
                                                                      fee credit
                                                                    then
                                                                    op_gtgteq
                                                                      (op_startypeminuserrorstar
                                                                        i
                                                                        delegate_op)
                                                                      (fun err
                                                                        =>
                                                                        op_startypeminuserrorstar
                                                                          __LOC__
                                                                          err
                                                                          (fun
                                                                            function_parameter
                                                                            =>
                                                                            match
                                                                              function_parameter
                                                                              with
                                                                            |
                                                                              Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                                                                _
                                                                                _
                                                                                _
                                                                              =>
                                                                              true
                                                                            | _
                                                                              =>
                                                                              false
                                                                            end))
                                                                  else
                                                                    op_gtgteqquestion
                                                                      (op_startypeminuserrorstar
                                                                        (expect_unregistered_key
                                                                          unregistered_delegate_pkh)
                                                                        i
                                                                        delegate_op)
                                                                      (fun i =>
                                                                        op_gtgteqquestion
                                                                          (op_startypeminuserrorstar
                                                                            __LOC__
                                                                            op_startypeminuserrorstar
                                                                            impl_contract
                                                                            credit
                                                                            fee)
                                                                          (fun
                                                                            function_parameter
                                                                            =>
                                                                            let
                                                                              'tt :=
                                                                              function_parameter
                                                                              in
                                                                            op_gtgteqquestion
                                                                              (op_startypeminuserrorstar
                                                                                op_startypeminuserrorstar
                                                                                impl_contract)
                                                                              (fun
                                                                                delegate
                                                                                =>
                                                                                op_startypeminuserrorstar
                                                                                  __LOC__
                                                                                  delegate
                                                                                  unregistered_delegate_pkh))))))))))))))))))).

Definition failed_self_delegation_no_transaction {A : Type}
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let account := op_startypeminuserrorstar tt in
          let unregistered_pkh := op_startypeminuserrorstar in
          let impl_contract := Contract.implicit_contract unregistered_pkh in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar impl_contract)
            (fun balance =>
              op_gtgteqquestion
                (op_startypeminuserrorstar __LOC__ Tez.zero balance)
                (fun function_parameter =>
                  let '_ := function_parameter in
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      impl_contract (Some unregistered_pkh))
                    (fun self_delegation =>
                      op_gtgteq (op_startypeminuserrorstar i self_delegation)
                        (fun err =>
                          op_startypeminuserrorstar __LOC__ err
                            (fun function_parameter =>
                              match function_parameter with
                              |
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_implicit_contract
                                  pkh =>
                                if
                                  op_startypeminuserrorstar pkh unregistered_pkh
                                  then
                                  true
                                else
                                  false
                              | _ => false
                              end))))))).

Definition failed_self_delegation_emptied_implicit_contract {A B : Type}
  (amount : A) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          let account := op_startypeminuserrorstar tt in
          let unregistered_pkh := op_startypeminuserrorstar in
          let impl_contract := Contract.implicit_contract unregistered_pkh in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap
              impl_contract amount)
            (fun create_contract =>
              op_gtgteqquestion (op_startypeminuserrorstar i create_contract)
                (fun i =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar __LOC__ op_startypeminuserrorstar
                      impl_contract amount)
                    (fun function_parameter =>
                      let '_ := function_parameter in
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          impl_contract bootstrap amount)
                        (fun create_contract =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar i create_contract)
                            (fun i =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar __LOC__
                                  op_startypeminuserrorstar impl_contract
                                  Tez.zero)
                                (fun function_parameter =>
                                  let '_ := function_parameter in
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar
                                      op_startypeminuserrorstar impl_contract
                                      (Some unregistered_pkh))
                                    (fun self_delegation =>
                                      op_gtgteq
                                        (op_startypeminuserrorstar i
                                          self_delegation)
                                        (fun err =>
                                          op_startypeminuserrorstar __LOC__ err
                                            (fun function_parameter =>
                                              match function_parameter with
                                              |
                                                Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_implicit_contract
                                                  pkh =>
                                                if
                                                  op_startypeminuserrorstar pkh
                                                    unregistered_pkh then
                                                  true
                                                else
                                                  false
                                              | _ => false
                                              end))))))))))).

Definition valid_delegate_registration_init_delegation_credit {A B : Type}
  (amount : A) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          let delegate_account := op_startypeminuserrorstar tt in
          let delegate_pkh := op_startypeminuserrorstar in
          let impl_contract := Contract.implicit_contract delegate_pkh in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap
              impl_contract amount)
            (fun create_contract =>
              op_gtgteqquestion (op_startypeminuserrorstar i create_contract)
                (fun i =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar __LOC__ op_startypeminuserrorstar
                      impl_contract amount)
                    (fun function_parameter =>
                      let '_ := function_parameter in
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          impl_contract (Some delegate_pkh))
                        (fun self_delegation =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar i self_delegation)
                            (fun i =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar
                                  op_startypeminuserrorstar impl_contract)
                                (fun delegate =>
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar __LOC__ delegate
                                      delegate_pkh)
                                    (fun function_parameter =>
                                      let '_ := function_parameter in
                                      let unregistered_account :=
                                        op_startypeminuserrorstar tt in
                                      let unregistered_pkh :=
                                        op_startypeminuserrorstar in
                                      let delegator :=
                                        Contract.implicit_contract
                                          unregistered_pkh in
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar Tez.zero
                                          op_startypeminuserrorstar bootstrap
                                          delegator Tez.one)
                                        (fun credit_contract =>
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar i
                                              credit_contract)
                                            (fun i =>
                                              op_gtgteq
                                                (op_startypeminuserrorstar
                                                  op_startypeminuserrorstar
                                                  delegator)
                                                (fun err =>
                                                  op_gtgteqquestion
                                                    (op_startypeminuserrorstar
                                                      __LOC__ err
                                                      (fun function_parameter =>
                                                        match function_parameter
                                                          with
                                                        | _ => true
                                                        | _ => false
                                                        end))
                                                    (fun function_parameter =>
                                                      let '_ :=
                                                        function_parameter in
                                                      op_gtgteqquestion
                                                        (op_startypeminuserrorstar
                                                          op_startypeminuserrorstar
                                                          delegator
                                                          (Some
                                                            (pkh
                                                              delegate_account)))
                                                        (fun delegation =>
                                                          op_gtgteqquestion
                                                            (op_startypeminuserrorstar
                                                              i delegation)
                                                            (fun i =>
                                                              op_gtgteqquestion
                                                                (op_startypeminuserrorstar
                                                                  op_startypeminuserrorstar
                                                                  delegator)
                                                                (fun
                                                                  delegator_delegate
                                                                  =>
                                                                  op_startypeminuserrorstar
                                                                    __LOC__
                                                                    delegator_delegate
                                                                    delegate_pkh)))))))))))))))).

Definition valid_delegate_registration_switch_delegation_credit {A B : Type}
  (amount : A) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          let delegate_account := op_startypeminuserrorstar tt in
          let delegate_pkh := op_startypeminuserrorstar in
          let impl_contract := Contract.implicit_contract delegate_pkh in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap
              impl_contract amount)
            (fun create_contract =>
              op_gtgteqquestion (op_startypeminuserrorstar i create_contract)
                (fun i =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar __LOC__ op_startypeminuserrorstar
                      impl_contract amount)
                    (fun function_parameter =>
                      let '_ := function_parameter in
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          impl_contract (Some delegate_pkh))
                        (fun self_delegation =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar i self_delegation)
                            (fun i =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar
                                  op_startypeminuserrorstar impl_contract)
                                (fun delegate =>
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar __LOC__ delegate
                                      delegate_pkh)
                                    (fun function_parameter =>
                                      let '_ := function_parameter in
                                      let unregistered_account :=
                                        op_startypeminuserrorstar tt in
                                      let unregistered_pkh :=
                                        op_startypeminuserrorstar in
                                      let delegator :=
                                        Contract.implicit_contract
                                          unregistered_pkh in
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar Tez.zero
                                          op_startypeminuserrorstar bootstrap
                                          delegator Tez.one)
                                        (fun credit_contract =>
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar i
                                              credit_contract)
                                            (fun i =>
                                              op_gtgteqquestion
                                                (op_startypeminuserrorstar
                                                  op_startypeminuserrorstar
                                                  bootstrap)
                                                (fun bootstrap_manager =>
                                                  op_gtgteqquestion
                                                    (op_startypeminuserrorstar
                                                      op_startypeminuserrorstar
                                                      delegator
                                                      (Some
                                                        (pkh bootstrap_manager)))
                                                    (fun delegation =>
                                                      op_gtgteqquestion
                                                        (op_startypeminuserrorstar
                                                          i delegation)
                                                        (fun i =>
                                                          op_gtgteqquestion
                                                            (op_startypeminuserrorstar
                                                              op_startypeminuserrorstar
                                                              delegator)
                                                            (fun
                                                              delegator_delegate
                                                              =>
                                                              op_gtgteqquestion
                                                                (op_startypeminuserrorstar
                                                                  __LOC__
                                                                  delegator_delegate
                                                                  (pkh
                                                                    bootstrap_manager))
                                                                (fun
                                                                  function_parameter
                                                                  =>
                                                                  let '_ :=
                                                                    function_parameter
                                                                    in
                                                                  op_gtgteqquestion
                                                                    (op_startypeminuserrorstar
                                                                      op_startypeminuserrorstar
                                                                      delegator
                                                                      (Some
                                                                        (pkh
                                                                          delegate_account)))
                                                                    (fun
                                                                      delegation
                                                                      =>
                                                                      op_gtgteqquestion
                                                                        (op_startypeminuserrorstar
                                                                          i
                                                                          delegation)
                                                                        (fun i
                                                                          =>
                                                                          op_gtgteqquestion
                                                                            (op_startypeminuserrorstar
                                                                              op_startypeminuserrorstar
                                                                              delegator)
                                                                            (fun
                                                                              delegator_delegate
                                                                              =>
                                                                              op_startypeminuserrorstar
                                                                                __LOC__
                                                                                delegator_delegate
                                                                                delegate_pkh))))))))))))))))))).

Definition valid_delegate_registration_init_delegation_credit_debit {A B : Type}
  (amount : A) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          let delegate_account := op_startypeminuserrorstar tt in
          let delegate_pkh := op_startypeminuserrorstar in
          let impl_contract := Contract.implicit_contract delegate_pkh in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap
              impl_contract amount)
            (fun create_contract =>
              op_gtgteqquestion (op_startypeminuserrorstar i create_contract)
                (fun i =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar __LOC__ op_startypeminuserrorstar
                      impl_contract amount)
                    (fun function_parameter =>
                      let '_ := function_parameter in
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          impl_contract (Some delegate_pkh))
                        (fun self_delegation =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar i self_delegation)
                            (fun i =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar
                                  op_startypeminuserrorstar impl_contract)
                                (fun delegate =>
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar __LOC__
                                      delegate_pkh delegate)
                                    (fun function_parameter =>
                                      let '_ := function_parameter in
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar
                                          op_startypeminuserrorstar
                                          impl_contract bootstrap amount)
                                        (fun empty_contract =>
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar i
                                              empty_contract)
                                            (fun i =>
                                              op_gtgteqquestion
                                                (op_startypeminuserrorstar
                                                  __LOC__
                                                  op_startypeminuserrorstar
                                                  impl_contract Tez.zero)
                                                (fun function_parameter =>
                                                  let '_ := function_parameter
                                                    in
                                                  op_gtgteqquestion
                                                    (op_startypeminuserrorstar
                                                      op_startypeminuserrorstar
                                                      impl_contract)
                                                    (fun delegate =>
                                                      op_gtgteqquestion
                                                        (op_startypeminuserrorstar
                                                          __LOC__ delegate_pkh
                                                          delegate)
                                                        (fun function_parameter
                                                          =>
                                                          let '_ :=
                                                            function_parameter
                                                            in
                                                          let
                                                            unregistered_account :=
                                                            op_startypeminuserrorstar
                                                              tt in
                                                          let
                                                            unregistered_pkh :=
                                                            op_startypeminuserrorstar
                                                            in
                                                          let delegator :=
                                                            Contract.implicit_contract
                                                              unregistered_pkh
                                                            in
                                                          op_gtgteqquestion
                                                            (op_startypeminuserrorstar
                                                              Tez.zero
                                                              op_startypeminuserrorstar
                                                              bootstrap
                                                              delegator Tez.one)
                                                            (fun credit_contract
                                                              =>
                                                              op_gtgteqquestion
                                                                (op_startypeminuserrorstar
                                                                  i
                                                                  credit_contract)
                                                                (fun i =>
                                                                  op_gtgteq
                                                                    (op_startypeminuserrorstar
                                                                      op_startypeminuserrorstar
                                                                      delegator)
                                                                    (fun err =>
                                                                      op_gtgteqquestion
                                                                        (op_startypeminuserrorstar
                                                                          __LOC__
                                                                          err
                                                                          (fun
                                                                            function_parameter
                                                                            =>
                                                                            match
                                                                              function_parameter
                                                                              with
                                                                            | _
                                                                              =>
                                                                              true
                                                                            | _
                                                                              =>
                                                                              false
                                                                            end))
                                                                        (fun
                                                                          function_parameter
                                                                          =>
                                                                          let
                                                                            '_ :=
                                                                            function_parameter
                                                                            in
                                                                          op_gtgteqquestion
                                                                            (op_startypeminuserrorstar
                                                                              op_startypeminuserrorstar
                                                                              delegator
                                                                              (Some
                                                                                (pkh
                                                                                  delegate_account)))
                                                                            (fun
                                                                              delegation
                                                                              =>
                                                                              op_gtgteqquestion
                                                                                (op_startypeminuserrorstar
                                                                                  i
                                                                                  delegation)
                                                                                (fun
                                                                                  i
                                                                                  =>
                                                                                  op_gtgteqquestion
                                                                                    (op_startypeminuserrorstar
                                                                                      op_startypeminuserrorstar
                                                                                      delegator)
                                                                                    (fun
                                                                                      delegator_delegate
                                                                                      =>
                                                                                      op_startypeminuserrorstar
                                                                                        __LOC__
                                                                                        delegator_delegate
                                                                                        delegate_pkh))))))))))))))))))))).

Definition valid_delegate_registration_switch_delegation_credit_debit
  {A B : Type} (amount : A) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          let delegate_account := op_startypeminuserrorstar tt in
          let delegate_pkh := op_startypeminuserrorstar in
          let impl_contract := Contract.implicit_contract delegate_pkh in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap
              impl_contract amount)
            (fun create_contract =>
              op_gtgteqquestion (op_startypeminuserrorstar i create_contract)
                (fun i =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar __LOC__ op_startypeminuserrorstar
                      impl_contract amount)
                    (fun function_parameter =>
                      let '_ := function_parameter in
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          impl_contract (Some delegate_pkh))
                        (fun self_delegation =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar i self_delegation)
                            (fun i =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar
                                  op_startypeminuserrorstar impl_contract)
                                (fun delegate =>
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar __LOC__
                                      delegate_pkh delegate)
                                    (fun function_parameter =>
                                      let '_ := function_parameter in
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar
                                          op_startypeminuserrorstar
                                          impl_contract bootstrap amount)
                                        (fun empty_contract =>
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar i
                                              empty_contract)
                                            (fun i =>
                                              op_gtgteqquestion
                                                (op_startypeminuserrorstar
                                                  __LOC__
                                                  op_startypeminuserrorstar
                                                  impl_contract Tez.zero)
                                                (fun function_parameter =>
                                                  let '_ := function_parameter
                                                    in
                                                  let unregistered_account :=
                                                    op_startypeminuserrorstar tt
                                                    in
                                                  let unregistered_pkh :=
                                                    op_startypeminuserrorstar in
                                                  let delegator :=
                                                    Contract.implicit_contract
                                                      unregistered_pkh in
                                                  op_gtgteqquestion
                                                    (op_startypeminuserrorstar
                                                      Tez.zero
                                                      op_startypeminuserrorstar
                                                      bootstrap delegator
                                                      Tez.one)
                                                    (fun credit_contract =>
                                                      op_gtgteqquestion
                                                        (op_startypeminuserrorstar
                                                          i credit_contract)
                                                        (fun i =>
                                                          op_gtgteqquestion
                                                            (op_startypeminuserrorstar
                                                              op_startypeminuserrorstar
                                                              bootstrap)
                                                            (fun
                                                              bootstrap_manager
                                                              =>
                                                              op_gtgteqquestion
                                                                (op_startypeminuserrorstar
                                                                  op_startypeminuserrorstar
                                                                  delegator
                                                                  (Some
                                                                    (pkh
                                                                      bootstrap_manager)))
                                                                (fun delegation
                                                                  =>
                                                                  op_gtgteqquestion
                                                                    (op_startypeminuserrorstar
                                                                      i
                                                                      delegation)
                                                                    (fun i =>
                                                                      op_gtgteqquestion
                                                                        (op_startypeminuserrorstar
                                                                          op_startypeminuserrorstar
                                                                          delegator)
                                                                        (fun
                                                                          delegator_delegate
                                                                          =>
                                                                          op_gtgteqquestion
                                                                            (op_startypeminuserrorstar
                                                                              __LOC__
                                                                              delegator_delegate
                                                                              (pkh
                                                                                bootstrap_manager))
                                                                            (fun
                                                                              function_parameter
                                                                              =>
                                                                              let
                                                                                '_ :=
                                                                                function_parameter
                                                                                in
                                                                              op_gtgteqquestion
                                                                                (op_startypeminuserrorstar
                                                                                  op_startypeminuserrorstar
                                                                                  delegator
                                                                                  (Some
                                                                                    (pkh
                                                                                      delegate_account)))
                                                                                (fun
                                                                                  delegation
                                                                                  =>
                                                                                  op_gtgteqquestion
                                                                                    (op_startypeminuserrorstar
                                                                                      i
                                                                                      delegation)
                                                                                    (fun
                                                                                      i
                                                                                      =>
                                                                                      op_gtgteqquestion
                                                                                        (op_startypeminuserrorstar
                                                                                          op_startypeminuserrorstar
                                                                                          delegator)
                                                                                        (fun
                                                                                          delegator_delegate
                                                                                          =>
                                                                                          op_startypeminuserrorstar
                                                                                            __LOC__
                                                                                            delegator_delegate
                                                                                            delegate_pkh)))))))))))))))))))))).

Definition double_registration {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          let account := op_startypeminuserrorstar tt in
          let pkh := op_startypeminuserrorstar in
          let impl_contract := Contract.implicit_contract pkh in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap
              impl_contract Tez.one_mutez)
            (fun create_contract =>
              op_gtgteqquestion (op_startypeminuserrorstar i create_contract)
                (fun i =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar __LOC__ op_startypeminuserrorstar
                      impl_contract Tez.one_mutez)
                    (fun function_parameter =>
                      let '_ := function_parameter in
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          impl_contract (Some pkh))
                        (fun self_delegation =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar i self_delegation)
                            (fun i =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar
                                  op_startypeminuserrorstar impl_contract
                                  (Some pkh))
                                (fun second_registration =>
                                  op_gtgteq
                                    (op_startypeminuserrorstar i
                                      second_registration)
                                    (fun err =>
                                      op_startypeminuserrorstar __LOC__ err
                                        (fun function_parameter =>
                                          match function_parameter with
                                          |
                                            Tezos_protocol_environment_alpha__Environment.Error_monad.Active_delegate
                                            => true
                                          | _ => false
                                          end)))))))))).

Definition double_registration_when_empty {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          let account := op_startypeminuserrorstar tt in
          let pkh := op_startypeminuserrorstar in
          let impl_contract := Contract.implicit_contract pkh in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap
              impl_contract Tez.one_mutez)
            (fun create_contract =>
              op_gtgteqquestion (op_startypeminuserrorstar i create_contract)
                (fun i =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar __LOC__ op_startypeminuserrorstar
                      impl_contract Tez.one_mutez)
                    (fun function_parameter =>
                      let '_ := function_parameter in
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          impl_contract (Some pkh))
                        (fun self_delegation =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar i self_delegation)
                            (fun i =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar
                                  op_startypeminuserrorstar impl_contract
                                  bootstrap Tez.one_mutez)
                                (fun empty_contract =>
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar i empty_contract)
                                    (fun i =>
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar __LOC__
                                          op_startypeminuserrorstar
                                          impl_contract Tez.zero)
                                        (fun function_parameter =>
                                          let '_ := function_parameter in
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar
                                              op_startypeminuserrorstar
                                              impl_contract (Some pkh))
                                            (fun second_registration =>
                                              op_gtgteq
                                                (op_startypeminuserrorstar i
                                                  second_registration)
                                                (fun err =>
                                                  op_startypeminuserrorstar
                                                    __LOC__ err
                                                    (fun function_parameter =>
                                                      match function_parameter
                                                        with
                                                      |
                                                        Tezos_protocol_environment_alpha__Environment.Error_monad.Active_delegate
                                                        => true
                                                      | _ => false
                                                      end))))))))))))).

Definition double_registration_when_recredited {A : Type}
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          let account := op_startypeminuserrorstar tt in
          let pkh := op_startypeminuserrorstar in
          let impl_contract := Contract.implicit_contract pkh in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap
              impl_contract Tez.one_mutez)
            (fun create_contract =>
              op_gtgteqquestion (op_startypeminuserrorstar i create_contract)
                (fun i =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar __LOC__ op_startypeminuserrorstar
                      impl_contract Tez.one_mutez)
                    (fun function_parameter =>
                      let '_ := function_parameter in
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          impl_contract (Some pkh))
                        (fun self_delegation =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar i self_delegation)
                            (fun i =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar
                                  op_startypeminuserrorstar impl_contract
                                  bootstrap Tez.one_mutez)
                                (fun empty_contract =>
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar i empty_contract)
                                    (fun i =>
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar __LOC__
                                          op_startypeminuserrorstar
                                          impl_contract Tez.zero)
                                        (fun function_parameter =>
                                          let '_ := function_parameter in
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar
                                              op_startypeminuserrorstar
                                              bootstrap impl_contract
                                              Tez.one_mutez)
                                            (fun create_contract =>
                                              op_gtgteqquestion
                                                (op_startypeminuserrorstar i
                                                  create_contract)
                                                (fun i =>
                                                  op_gtgteqquestion
                                                    (op_startypeminuserrorstar
                                                      __LOC__
                                                      op_startypeminuserrorstar
                                                      impl_contract
                                                      Tez.one_mutez)
                                                    (fun function_parameter =>
                                                      let '_ :=
                                                        function_parameter in
                                                      op_gtgteqquestion
                                                        (op_startypeminuserrorstar
                                                          op_startypeminuserrorstar
                                                          impl_contract
                                                          (Some pkh))
                                                        (fun second_registration
                                                          =>
                                                          op_gtgteq
                                                            (op_startypeminuserrorstar
                                                              i
                                                              second_registration)
                                                            (fun err =>
                                                              op_startypeminuserrorstar
                                                                __LOC__ err
                                                                (fun
                                                                  function_parameter
                                                                  =>
                                                                  match
                                                                    function_parameter
                                                                    with
                                                                  |
                                                                    Tezos_protocol_environment_alpha__Environment.Error_monad.Active_delegate
                                                                    => true
                                                                  | _ => false
                                                                  end)))))))))))))))).

Definition unregistered_and_unrevealed_self_delegate_key_init_delegation
  {A B : Type} (fee : A) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          let '_ := op_startypeminuserrorstar tt in
          let '_ := op_startypeminuserrorstar tt in
          let contract :=
            Alpha_context.Contract.implicit_contract op_startypeminuserrorstar
            in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap
              contract (op_startypeminuserrorstar 10))
            (fun op =>
              op_gtgteqquestion (op_startypeminuserrorstar i op)
                (fun i =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar fee op_startypeminuserrorstar
                      contract (Some op_startypeminuserrorstar))
                    (fun op =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          contract)
                        (fun balance =>
                          if op_startypeminuserrorstar fee balance then
                            op_gtgteq (op_startypeminuserrorstar i op)
                              (fun err =>
                                op_startypeminuserrorstar __LOC__ err
                                  (fun function_parameter =>
                                    match function_parameter with
                                    |
                                      Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                        _ _ _ => true
                                    | _ => false
                                    end))
                          else
                            op_gtgteqquestion
                              (op_startypeminuserrorstar
                                (expect_unregistered_key
                                  op_startypeminuserrorstar) i op)
                              (fun i =>
                                op_startypeminuserrorstar __LOC__
                                  op_startypeminuserrorstar contract balance fee))))))).

Definition unregistered_and_revealed_self_delegate_key_init_delegation
  {A B : Type} (fee : A) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          let '_ := op_startypeminuserrorstar tt in
          let '_ := op_startypeminuserrorstar tt in
          let contract :=
            Alpha_context.Contract.implicit_contract op_startypeminuserrorstar
            in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap
              contract (op_startypeminuserrorstar 10))
            (fun op =>
              op_gtgteqquestion (op_startypeminuserrorstar i op)
                (fun i =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      op_startypeminuserrorstar)
                    (fun op =>
                      op_gtgteqquestion (op_startypeminuserrorstar i op)
                        (fun i =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar fee
                              op_startypeminuserrorstar contract
                              (Some op_startypeminuserrorstar))
                            (fun op =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar
                                  op_startypeminuserrorstar contract)
                                (fun balance =>
                                  if op_startypeminuserrorstar fee balance then
                                    op_gtgteq (op_startypeminuserrorstar i op)
                                      (fun err =>
                                        op_startypeminuserrorstar __LOC__ err
                                          (fun function_parameter =>
                                            match function_parameter with
                                            |
                                              Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                                _ _ _ => true
                                            | _ => false
                                            end))
                                  else
                                    op_gtgteqquestion
                                      (op_startypeminuserrorstar
                                        (expect_unregistered_key
                                          op_startypeminuserrorstar) i op)
                                      (fun i =>
                                        op_startypeminuserrorstar __LOC__
                                          op_startypeminuserrorstar contract
                                          balance fee))))))))).

Definition registered_self_delegate_key_init_delegation
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, bootstrap_contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let bootstrap := List.hd bootstrap_contracts in
          let '_ := op_startypeminuserrorstar tt in
          let '_ := op_startypeminuserrorstar tt in
          let contract :=
            Alpha_context.Contract.implicit_contract op_startypeminuserrorstar
            in
          let delegate_contract :=
            Alpha_context.Contract.implicit_contract op_startypeminuserrorstar
            in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar bootstrap
              contract (op_startypeminuserrorstar 10))
            (fun op =>
              op_gtgteqquestion (op_startypeminuserrorstar i op)
                (fun i =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      bootstrap delegate_contract (op_startypeminuserrorstar 1))
                    (fun op =>
                      op_gtgteqquestion (op_startypeminuserrorstar i op)
                        (fun i =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar op_startypeminuserrorstar
                              op_startypeminuserrorstar)
                            (fun op =>
                              op_gtgteqquestion (op_startypeminuserrorstar i op)
                                (fun i =>
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar
                                      op_startypeminuserrorstar
                                      delegate_contract
                                      (Some op_startypeminuserrorstar))
                                    (fun op =>
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar i op)
                                        (fun i =>
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar
                                              op_startypeminuserrorstar contract
                                              (Some op_startypeminuserrorstar))
                                            (fun op =>
                                              op_gtgteqquestion
                                                (op_startypeminuserrorstar i op)
                                                (fun i =>
                                                  op_gtgteqquestion
                                                    (op_startypeminuserrorstar
                                                      op_startypeminuserrorstar
                                                      contract)
                                                    (fun delegate =>
                                                      op_gtgteqquestion
                                                        (op_startypeminuserrorstar
                                                          __LOC__ delegate
                                                          op_startypeminuserrorstar)
                                                        (fun function_parameter
                                                          =>
                                                          let 'tt :=
                                                            function_parameter
                                                            in
                                                          return_unit)))))))))))))).

Definition tests_delegate_registration {A : Type} : list A :=
  cons
    (op_startypeminuserrorstar
      "unregistered delegate key (origination, small fee)" % string
      (* ❌ Variants not supported *)
      variant (unregistered_delegate_key_init_origination Tez.one_mutez))
    (cons
      (op_startypeminuserrorstar
        "unregistered delegate key (origination, edge case fee)" % string
        (* ❌ Variants not supported *)
        variant
        (unregistered_delegate_key_init_origination
          (op_startypeminuserrorstar 3999488)))
      (cons
        (op_startypeminuserrorstar
          "unregistered delegate key (origination, large fee)" % string
          (* ❌ Variants not supported *)
          variant
          (unregistered_delegate_key_init_origination
            (op_startypeminuserrorstar 10000000)))
        (cons
          (op_startypeminuserrorstar
            "unregistered delegate key (init with delegation, small fee)" %
              string
            (* ❌ Variants not supported *)
            variant (unregistered_delegate_key_init_delegation Tez.one_mutez))
          (cons
            (op_startypeminuserrorstar
              "unregistered delegate key (init with delegation, max fee)" %
                string
              (* ❌ Variants not supported *)
              variant
              (unregistered_delegate_key_init_delegation
                op_startypeminuserrorstar))
            (cons
              (op_startypeminuserrorstar
                "unregistered delegate key (switch with delegation, small fee)"
                  % string
                (* ❌ Variants not supported *)
                variant
                (unregistered_delegate_key_switch_delegation Tez.one_mutez))
              (cons
                (op_startypeminuserrorstar
                  "unregistered delegate key (switch with delegation, max fee)"
                    % string
                  (* ❌ Variants not supported *)
                  variant
                  (unregistered_delegate_key_switch_delegation
                    op_startypeminuserrorstar))
                (cons
                  (op_startypeminuserrorstar
                    "unregistered delegate key - credit/debit 1μꜩ (origination, small fee)"
                      % string
                    (* ❌ Variants not supported *)
                    variant
                    (unregistered_delegate_key_init_origination_credit_debit
                      Tez.one_mutez Tez.one_mutez))
                  (cons
                    (op_startypeminuserrorstar
                      "unregistered delegate key - credit/debit 1μꜩ (origination, large fee)"
                        % string
                      (* ❌ Variants not supported *)
                      variant
                      (unregistered_delegate_key_init_origination_credit_debit
                        op_startypeminuserrorstar Tez.one_mutez))
                    (cons
                      (op_startypeminuserrorstar
                        "unregistered delegate key - credit/debit 1μꜩ (init with delegation, small fee)"
                          % string
                        (* ❌ Variants not supported *)
                        variant
                        (unregistered_delegate_key_init_delegation_credit_debit
                          Tez.one_mutez Tez.one_mutez))
                      (cons
                        (op_startypeminuserrorstar
                          "unregistered delegate key - credit/debit 1μꜩ (init with delegation, large fee)"
                            % string
                          (* ❌ Variants not supported *)
                          variant
                          (unregistered_delegate_key_init_delegation_credit_debit
                            Tez.one_mutez op_startypeminuserrorstar))
                        (cons
                          (op_startypeminuserrorstar
                            "unregistered delegate key - credit/debit 1μꜩ (switch with delegation, small fee)"
                              % string
                            (* ❌ Variants not supported *)
                            variant
                            (unregistered_delegate_key_switch_delegation_credit_debit
                              Tez.one_mutez Tez.one_mutez))
                          (cons
                            (op_startypeminuserrorstar
                              "unregistered delegate key - credit/debit 1μꜩ (switch with delegation, large fee)"
                                % string
                              (* ❌ Variants not supported *)
                              variant
                              (unregistered_delegate_key_switch_delegation_credit_debit
                                op_startypeminuserrorstar Tez.one_mutez))
                            (cons
                              (op_startypeminuserrorstar
                                "unregistered delegate key - credit 1μꜩ (origination, small fee)"
                                  % string
                                (* ❌ Variants not supported *)
                                variant
                                (unregistered_delegate_key_init_origination_credit
                                  Tez.one_mutez Tez.one_mutez))
                              (cons
                                (op_startypeminuserrorstar
                                  "unregistered delegate key - credit 1μꜩ (origination, edge case fee)"
                                    % string
                                  (* ❌ Variants not supported *)
                                  variant
                                  (unregistered_delegate_key_init_origination_credit
                                    (op_startypeminuserrorstar 3999488)
                                    Tez.one_mutez))
                                (cons
                                  (op_startypeminuserrorstar
                                    "unregistered delegate key - credit 1μꜩ (origination, large fee)"
                                      % string
                                    (* ❌ Variants not supported *)
                                    variant
                                    (unregistered_delegate_key_init_origination_credit
                                      (op_startypeminuserrorstar 10000000)
                                      Tez.one_mutez))
                                  (cons
                                    (op_startypeminuserrorstar
                                      "unregistered delegate key - credit 1μꜩ (init with delegation, small fee)"
                                        % string
                                      (* ❌ Variants not supported *)
                                      variant
                                      (unregistered_delegate_key_init_delegation_credit
                                        Tez.one_mutez Tez.one_mutez))
                                    (cons
                                      (op_startypeminuserrorstar
                                        "unregistered delegate key - credit 1μꜩ (init with delegation, large fee)"
                                          % string
                                        (* ❌ Variants not supported *)
                                        variant
                                        (unregistered_delegate_key_init_delegation_credit
                                          op_startypeminuserrorstar
                                          Tez.one_mutez))
                                      (cons
                                        (op_startypeminuserrorstar
                                          "unregistered delegate key - credit 1μꜩ (switch with delegation, small fee)"
                                            % string
                                          (* ❌ Variants not supported *)
                                          variant
                                          (unregistered_delegate_key_switch_delegation_credit
                                            Tez.one_mutez Tez.one_mutez))
                                        (cons
                                          (op_startypeminuserrorstar
                                            "unregistered delegate key - credit 1μꜩ (switch with delegation, large fee)"
                                              % string
                                            (* ❌ Variants not supported *)
                                            variant
                                            (unregistered_delegate_key_switch_delegation_credit
                                              op_startypeminuserrorstar
                                              Tez.one_mutez))
                                          (cons
                                            (op_startypeminuserrorstar
                                              "unregistered and unrevealed self-delegation (small fee)"
                                                % string
                                              (* ❌ Variants not supported *)
                                              variant
                                              (unregistered_and_unrevealed_self_delegate_key_init_delegation
                                                Tez.one_mutez))
                                            (cons
                                              (op_startypeminuserrorstar
                                                "unregistered and unrevealed self-delegation (large fee)"
                                                  % string
                                                (* ❌ Variants not supported *)
                                                variant
                                                (unregistered_and_unrevealed_self_delegate_key_init_delegation
                                                  op_startypeminuserrorstar))
                                              (cons
                                                (op_startypeminuserrorstar
                                                  "unregistered and revealed self-delegation (small fee)"
                                                    % string
                                                  (* ❌ Variants not supported *)
                                                  variant
                                                  (unregistered_and_revealed_self_delegate_key_init_delegation
                                                    Tez.one_mutez))
                                                (cons
                                                  (op_startypeminuserrorstar
                                                    "unregistered and revealed self-delegation  large fee)"
                                                      % string
                                                    (* ❌ Variants not supported *)
                                                    variant
                                                    (unregistered_and_revealed_self_delegate_key_init_delegation
                                                      op_startypeminuserrorstar))
                                                  (cons
                                                    (op_startypeminuserrorstar
                                                      "registered and revelead self-delegation"
                                                        % string
                                                      (* ❌ Variants not supported *)
                                                      variant
                                                      registered_self_delegate_key_init_delegation)
                                                    (cons
                                                      (op_startypeminuserrorstar
                                                        "failed self-delegation: no transaction"
                                                          % string
                                                        (* ❌ Variants not supported *)
                                                        variant
                                                        failed_self_delegation_no_transaction)
                                                      (cons
                                                        (op_startypeminuserrorstar
                                                          "failed self-delegation: credit & debit 1μꜩ"
                                                            % string
                                                          (* ❌ Variants not supported *)
                                                          variant
                                                          (failed_self_delegation_emptied_implicit_contract
                                                            Tez.one_mutez))
                                                        (cons
                                                          (op_startypeminuserrorstar
                                                            "valid delegate registration: credit 1μꜩ, self delegation (init with delegation)"
                                                              % string
                                                            (* ❌ Variants not supported *)
                                                            variant
                                                            (valid_delegate_registration_init_delegation_credit
                                                              Tez.one_mutez))
                                                          (cons
                                                            (op_startypeminuserrorstar
                                                              "valid delegate registration: credit 1μꜩ, self delegation (switch with delegation)"
                                                                % string
                                                              (* ❌ Variants not supported *)
                                                              variant
                                                              (valid_delegate_registration_switch_delegation_credit
                                                                Tez.one_mutez))
                                                            (cons
                                                              (op_startypeminuserrorstar
                                                                "valid delegate registration: credit 1μꜩ, self delegation, debit 1μꜩ (init with delegation)"
                                                                  % string
                                                                (* ❌ Variants not supported *)
                                                                variant
                                                                (valid_delegate_registration_init_delegation_credit_debit
                                                                  Tez.one_mutez))
                                                              (cons
                                                                (op_startypeminuserrorstar
                                                                  "valid delegate registration: credit 1μꜩ, self delegation, debit 1μꜩ (switch with delegation)"
                                                                    % string
                                                                  (* ❌ Variants not supported *)
                                                                  variant
                                                                  (valid_delegate_registration_switch_delegation_credit_debit
                                                                    Tez.one_mutez))
                                                                (cons
                                                                  (op_startypeminuserrorstar
                                                                    "double registration"
                                                                      % string
                                                                    (* ❌ Variants not supported *)
                                                                    variant
                                                                    double_registration)
                                                                  (cons
                                                                    (op_startypeminuserrorstar
                                                                      "double registration when delegate account is emptied"
                                                                        % string
                                                                      (* ❌ Variants not supported *)
                                                                      variant
                                                                      double_registration_when_empty)
                                                                    (cons
                                                                      (op_startypeminuserrorstar
                                                                        "double registration when delegate account is emptied and then recredited"
                                                                          %
                                                                          string
                                                                        (* ❌ Variants not supported *)
                                                                        variant
                                                                        double_registration_when_recredited)
                                                                      []))))))))))))))))))))))))))))))))).

Definition tests {A : Type} : list A :=
  op_at tests_bootstrap_contracts tests_delegate_registration.
test/double_baking.ml 105 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Double baking evidence operation may happen when a baker
    baked two different blocks on the same level. *)

open Protocol
open Alpha_context

(****************************************************************)
(*                  Utility functions                           *)
(****************************************************************)

let get_first_different_baker baker bakers =
  return
  @@ List.find
       (fun baker' -> Signature.Public_key_hash.( <> ) baker baker')
       bakers

let get_first_different_bakers ctxt =
  Context.get_bakers ctxt
  >>=? fun bakers ->
  let baker_1 = List.hd bakers in
  get_first_different_baker baker_1 (List.tl bakers)
  >>=? fun baker_2 -> return (baker_1, baker_2)

let get_first_different_endorsers ctxt =
  Context.get_endorsers ctxt
  >>=? fun endorsers ->
  let endorser_1 = (List.hd endorsers).delegate in
  let endorser_2 = (List.hd (List.tl endorsers)).delegate in
  return (endorser_1, endorser_2)

(** Bake two block at the same level using the same policy (i.e. same
    baker) *)
let block_fork ?policy contracts b =
  let (contract_a, contract_b) =
    (List.hd contracts, List.hd (List.tl contracts))
  in
  Op.transaction (B b) contract_a contract_b Alpha_context.Tez.one_cent
  >>=? fun operation ->
  Block.bake ?policy ~operation b
  >>=? fun blk_a -> Block.bake ?policy b >>=? fun blk_b -> return (blk_a, blk_b)

(****************************************************************)
(*                        Tests                                 *)
(****************************************************************)

(** Simple scenario where two blocks are baked by a same baker and
    exposed by a double baking evidence operation *)
let valid_double_baking_evidence () =
  Context.init 2
  >>=? fun (b, contracts) ->
  Context.get_bakers (B b)
  >>=? fun bakers ->
  let priority_0_baker = List.hd bakers in
  block_fork ~policy:(By_priority 0) contracts b
  >>=? fun (blk_a, blk_b) ->
  Op.double_baking (B blk_a) blk_a.header blk_b.header
  >>=? fun operation ->
  Block.bake ~policy:(Excluding [priority_0_baker]) ~operation blk_a
  >>=? fun blk ->
  (* Check that the frozen deposit, the fees and rewards are removed *)
  iter_s
    (fun kind ->
      let contract =
        Alpha_context.Contract.implicit_contract priority_0_baker
      in
      Assert.balance_is ~loc:__LOC__ (B blk) contract ~kind Tez.zero)
    [Deposit; Fees; Rewards]

(****************************************************************)
(*  The following test scenarios are supposed to raise errors.  *)
(****************************************************************)

(** Check that a double baking operation fails if it exposes the same two blocks *)
let same_blocks () =
  Context.init 2
  >>=? fun (b, _contracts) ->
  Block.bake b
  >>=? fun ba ->
  Op.double_baking (B ba) ba.header ba.header
  >>=? fun operation ->
  Block.bake ~operation ba
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Apply.Invalid_double_baking_evidence _ ->
          true
      | _ ->
          false)
  >>=? fun () -> return_unit

(** Check that a double baking operation exposing two blocks with
    different levels fails *)
let different_levels () =
  Context.init 2
  >>=? fun (b, contracts) ->
  block_fork ~policy:(By_priority 0) contracts b
  >>=? fun (blk_a, blk_b) ->
  Block.bake blk_b
  >>=? fun blk_b_2 ->
  Op.double_baking (B blk_a) blk_a.header blk_b_2.header
  >>=? fun operation ->
  Block.bake ~operation blk_a
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Apply.Invalid_double_baking_evidence _ ->
          true
      | _ ->
          false)

(** Check that a double baking operation exposing two yet to be baked
    blocks fails *)
let too_early_double_baking_evidence () =
  Context.init 2
  >>=? fun (b, contracts) ->
  block_fork ~policy:(By_priority 0) contracts b
  >>=? fun (blk_a, blk_b) ->
  Op.double_baking (B b) blk_a.header blk_b.header
  >>=? fun operation ->
  Block.bake ~operation b
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Apply.Too_early_double_baking_evidence _ ->
          true
      | _ ->
          false)

(** Check that after [preserved_cycles + 1], it is not possible to
    create a double baking operation anymore *)
let too_late_double_baking_evidence () =
  Context.init 2
  >>=? fun (b, contracts) ->
  Context.get_constants (B b)
  >>=? fun Constants.{parametric = {preserved_cycles; _}; _} ->
  block_fork ~policy:(By_priority 0) contracts b
  >>=? fun (blk_a, blk_b) ->
  fold_left_s
    (fun blk _ -> Block.bake_until_cycle_end blk)
    blk_a
    (1 -- (preserved_cycles + 1))
  >>=? fun blk ->
  Op.double_baking (B blk) blk_a.header blk_b.header
  >>=? fun operation ->
  Block.bake ~operation blk
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Apply.Outdated_double_baking_evidence _ ->
          true
      | _ ->
          false)

(** Check that an invalid double baking evidence that exposes two block
    baking with same level made by different bakers fails *)
let different_delegates () =
  Context.init 2
  >>=? fun (b, _) ->
  get_first_different_bakers (B b)
  >>=? fun (baker_1, baker_2) ->
  Block.bake ~policy:(By_account baker_1) b
  >>=? fun blk_a ->
  Block.bake ~policy:(By_account baker_2) b
  >>=? fun blk_b ->
  Op.double_baking (B blk_a) blk_a.header blk_b.header
  >>=? fun operation ->
  Block.bake ~operation blk_a
  >>= fun e ->
  Assert.proto_error ~loc:__LOC__ e (function
      | Apply.Inconsistent_double_baking_evidence _ ->
          true
      | _ ->
          false)

let wrong_signer () =
  (* Baker_2 bakes a block but baker signs it. *)
  let header_custom_signer baker baker_2 b =
    Block.Forge.forge_header ~policy:(By_account baker_2) b
    >>=? fun header ->
    Block.Forge.set_baker baker header |> Block.Forge.sign_header
  in
  Context.init 2
  >>=? fun (b, _) ->
  get_first_different_bakers (B b)
  >>=? fun (baker_1, baker_2) ->
  Block.bake ~policy:(By_account baker_1) b
  >>=? fun blk_a ->
  header_custom_signer baker_1 baker_2 b
  >>=? fun header_b ->
  Op.double_baking (B blk_a) blk_a.header header_b
  >>=? fun operation ->
  Block.bake ~operation blk_a
  >>= fun e ->
  Assert.proto_error ~loc:__LOC__ e (function
      | Baking.Invalid_block_signature _ ->
          true
      | _ ->
          false)

let tests =
  [ Test.tztest
      "valid double baking evidence"
      `Quick
      valid_double_baking_evidence;
    (* Should fail*)
    Test.tztest "same blocks" `Quick same_blocks;
    Test.tztest "different levels" `Quick different_levels;
    Test.tztest
      "too early double baking evidence"
      `Quick
      too_early_double_baking_evidence;
    Test.tztest
      "too late double baking evidence"
      `Quick
      too_late_double_baking_evidence;
    Test.tztest "different delegates" `Quick different_delegates;
    Test.tztest "wrong delegate" `Quick wrong_signer ]
double_baking_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Protocol.

Import Alpha_context.

Definition get_first_different_baker {A B : Type}
  (baker :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (bakers : A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
  op_atat __return
    (op_startypeminuserrorstar
      (fun baker' => Signature.Public_key_hash.op_ltgt baker baker') bakers).

Definition get_first_different_bakers {A B : Type} (ctxt : A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
        * B)) :=
  op_gtgteqquestion (op_startypeminuserrorstar ctxt)
    (fun bakers =>
      let baker_1 := List.hd bakers in
      op_gtgteqquestion (get_first_different_baker baker_1 (List.tl bakers))
        (fun baker_2 => __return (baker_1, baker_2))).

Definition get_first_different_endorsers {A B C : Type} (ctxt : A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult (B * C)) :=
  op_gtgteqquestion (op_startypeminuserrorstar ctxt)
    (fun endorsers =>
      let endorser_1 := delegate (List.hd endorsers) in
      let endorser_2 := delegate (List.hd (List.tl endorsers)) in
      __return (endorser_1, endorser_2)).

Definition block_fork {A B C D E : Type}
  (policy : option A) (contracts : list B) (b : C)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult (D * E)) :=
  let '(contract_a, contract_b) :=
    ((List.hd contracts), (List.hd (List.tl contracts))) in
  op_gtgteqquestion
    (op_startypeminuserrorstar op_startypeminuserrorstar contract_a contract_b
      Alpha_context.Tez.one_cent)
    (fun operation =>
      op_gtgteqquestion (op_startypeminuserrorstar policy operation b)
        (fun blk_a =>
          op_gtgteqquestion (op_startypeminuserrorstar policy b)
            (fun blk_b => __return (blk_a, blk_b)))).

Definition valid_double_baking_evidence (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(b, contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
        (fun bakers =>
          let priority_0_baker := List.hd bakers in
          op_gtgteqquestion
            (block_fork (Some op_startypeminuserrorstar) contracts b)
            (fun function_parameter =>
              let '(blk_a, blk_b) := function_parameter in
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar
                  (header blk_a) (header blk_b))
                (fun operation =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      operation blk_a)
                    (fun blk =>
                      iter_s
                        (fun kind =>
                          let contract :=
                            Alpha_context.Contract.implicit_contract
                              priority_0_baker in
                          op_startypeminuserrorstar __LOC__
                            op_startypeminuserrorstar contract kind Tez.zero)
                        (cons op_startypeminuserrorstar
                          (cons op_startypeminuserrorstar
                            (cons op_startypeminuserrorstar [])))))))).

Definition same_blocks (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(b, _contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun ba =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar (header ba)
              (header ba))
            (fun operation =>
              op_gtgteq (op_startypeminuserrorstar operation ba)
                (fun res =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar __LOC__ res
                      (fun function_parameter =>
                        match function_parameter with
                        |
                          Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_double_baking_evidence
                            _ => true
                        | _ => false
                        end))
                    (fun function_parameter =>
                      let 'tt := function_parameter in
                      return_unit))))).

Definition different_levels {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(b, contracts) := function_parameter in
      op_gtgteqquestion
        (block_fork (Some op_startypeminuserrorstar) contracts b)
        (fun function_parameter =>
          let '(blk_a, blk_b) := function_parameter in
          op_gtgteqquestion (op_startypeminuserrorstar blk_b)
            (fun blk_b_2 =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar
                  (header blk_a) (header blk_b_2))
                (fun operation =>
                  op_gtgteq (op_startypeminuserrorstar operation blk_a)
                    (fun res =>
                      op_startypeminuserrorstar __LOC__ res
                        (fun function_parameter =>
                          match function_parameter with
                          |
                            Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_double_baking_evidence
                              _ => true
                          | _ => false
                          end)))))).

Definition too_early_double_baking_evidence {A : Type}
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(b, contracts) := function_parameter in
      op_gtgteqquestion
        (block_fork (Some op_startypeminuserrorstar) contracts b)
        (fun function_parameter =>
          let '(blk_a, blk_b) := function_parameter in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar (header blk_a)
              (header blk_b))
            (fun operation =>
              op_gtgteq (op_startypeminuserrorstar operation b)
                (fun res =>
                  op_startypeminuserrorstar __LOC__ res
                    (fun function_parameter =>
                      match function_parameter with
                      |
                        Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_double_baking_evidence
                          _ => true
                      | _ => false
                      end))))).

Definition too_late_double_baking_evidence {A : Type}
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(b, contracts) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
        (fun function_parameter =>
          let '{| parametric := {| preserved_cycles := preserved_cycles |} |} :=
            function_parameter in
          op_gtgteqquestion
            (block_fork (Some op_startypeminuserrorstar) contracts b)
            (fun function_parameter =>
              let '(blk_a, blk_b) := function_parameter in
              op_gtgteqquestion
                (fold_left_s
                  (fun blk =>
                    fun function_parameter =>
                      let '_ := function_parameter in
                      op_startypeminuserrorstar blk) blk_a
                  (op_startypeminuserrorstar 1 (op_plus preserved_cycles 1)))
                (fun blk =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      (header blk_a) (header blk_b))
                    (fun operation =>
                      op_gtgteq (op_startypeminuserrorstar operation blk)
                        (fun res =>
                          op_startypeminuserrorstar __LOC__ res
                            (fun function_parameter =>
                              match function_parameter with
                              |
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Outdated_double_baking_evidence
                                  _ => true
                              | _ => false
                              end))))))).

Definition different_delegates {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion (get_first_different_bakers op_startypeminuserrorstar)
        (fun function_parameter =>
          let '(baker_1, baker_2) := function_parameter in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar b)
            (fun blk_a =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar b)
                (fun blk_b =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      (header blk_a) (header blk_b))
                    (fun operation =>
                      op_gtgteq (op_startypeminuserrorstar operation blk_a)
                        (fun e =>
                          op_startypeminuserrorstar __LOC__ e
                            (fun function_parameter =>
                              match function_parameter with
                              |
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_double_baking_evidence
                                  _ => true
                              | _ => false
                              end))))))).

Definition wrong_signer {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  let header_custom_signer {B C D E : Type} (baker : B) (baker_2 : C) (b : D)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult E) :=
    op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar b)
      (fun header =>
        op_pipegt (op_startypeminuserrorstar baker header)
          op_startypeminuserrorstar) in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion (get_first_different_bakers op_startypeminuserrorstar)
        (fun function_parameter =>
          let '(baker_1, baker_2) := function_parameter in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar b)
            (fun blk_a =>
              op_gtgteqquestion (header_custom_signer baker_1 baker_2 b)
                (fun header_b =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      (header blk_a) header_b)
                    (fun operation =>
                      op_gtgteq (op_startypeminuserrorstar operation blk_a)
                        (fun e =>
                          op_startypeminuserrorstar __LOC__ e
                            (fun function_parameter =>
                              match function_parameter with
                              |
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_block_signature
                                  _ _ => true
                              | _ => false
                              end))))))).

Definition tests {A : Type} : list A :=
  cons
    (op_startypeminuserrorstar "valid double baking evidence" % string
      (* ❌ Variants not supported *)
      variant valid_double_baking_evidence)
    (cons
      (op_startypeminuserrorstar "same blocks" % string
        (* ❌ Variants not supported *)
        variant same_blocks)
      (cons
        (op_startypeminuserrorstar "different levels" % string
          (* ❌ Variants not supported *)
          variant different_levels)
        (cons
          (op_startypeminuserrorstar "too early double baking evidence" % string
            (* ❌ Variants not supported *)
            variant too_early_double_baking_evidence)
          (cons
            (op_startypeminuserrorstar
              "too late double baking evidence" % string
              (* ❌ Variants not supported *)
              variant too_late_double_baking_evidence)
            (cons
              (op_startypeminuserrorstar "different delegates" % string
                (* ❌ Variants not supported *)
                variant different_delegates)
              (cons
                (op_startypeminuserrorstar "wrong delegate" % string
                  (* ❌ Variants not supported *)
                  variant wrong_signer) [])))))).
test/double_endorsement.ml 121 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Double endorsement evidence operation may happen when an endorser
    endorsed two different blocks on the same level. *)

open Protocol
open Alpha_context

(****************************************************************)
(*                  Utility functions                           *)
(****************************************************************)

let get_first_different_baker baker bakers =
  return
  @@ List.find
       (fun baker' -> Signature.Public_key_hash.( <> ) baker baker')
       bakers

let get_first_different_bakers ctxt =
  Context.get_bakers ctxt
  >>=? fun bakers ->
  let baker_1 = List.hd bakers in
  get_first_different_baker baker_1 (List.tl bakers)
  >>=? fun baker_2 -> return (baker_1, baker_2)

let get_first_different_endorsers ctxt =
  Context.get_endorsers ctxt
  >>=? fun endorsers ->
  let endorser_1 = List.hd endorsers in
  let endorser_2 = List.hd (List.tl endorsers) in
  return (endorser_1, endorser_2)

let block_fork b =
  get_first_different_bakers (B b)
  >>=? fun (baker_1, baker_2) ->
  Block.bake ~policy:(By_account baker_1) b
  >>=? fun blk_a ->
  Block.bake ~policy:(By_account baker_2) b
  >>=? fun blk_b -> return (blk_a, blk_b)

(****************************************************************)
(*                        Tests                                 *)
(****************************************************************)

(** Simple scenario where two endorsements are made from the same
    delegate and exposed by a double_endorsement operation. Also verify
    that punishment is operated. *)
let valid_double_endorsement_evidence () =
  Context.init 2
  >>=? fun (b, _) ->
  block_fork b
  >>=? fun (blk_a, blk_b) ->
  Context.get_endorser (B blk_a)
  >>=? fun (delegate, _slots) ->
  Op.endorsement ~delegate (B blk_a) ()
  >>=? fun endorsement_a ->
  Op.endorsement ~delegate (B blk_b) ()
  >>=? fun endorsement_b ->
  Block.bake ~operations:[Operation.pack endorsement_a] blk_a
  >>=? fun blk_a ->
  (* Block.bake ~operations:[endorsement_b] blk_b >>=? fun _ -> *)
  Op.double_endorsement (B blk_a) endorsement_a endorsement_b
  >>=? fun operation ->
  (* Bake with someone different than the bad endorser *)
  Context.get_bakers (B blk_a)
  >>=? fun bakers ->
  get_first_different_baker delegate bakers
  >>=? fun baker ->
  Block.bake ~policy:(By_account baker) ~operation blk_a
  >>=? fun blk ->
  (* Check that the frozen deposit, the fees and rewards are removed *)
  iter_s
    (fun kind ->
      let contract = Alpha_context.Contract.implicit_contract delegate in
      Assert.balance_is ~loc:__LOC__ (B blk) contract ~kind Tez.zero)
    [Deposit; Fees; Rewards]

(****************************************************************)
(*  The following test scenarios are supposed to raise errors.  *)
(****************************************************************)

(** Check that an invalid double endorsement operation that exposes a valid
    endorsement fails. *)
let invalid_double_endorsement () =
  Context.init 10
  >>=? fun (b, _) ->
  Block.bake b
  >>=? fun b ->
  Op.endorsement (B b) ()
  >>=? fun endorsement ->
  Block.bake ~operation:(Operation.pack endorsement) b
  >>=? fun b ->
  Op.double_endorsement (B b) endorsement endorsement
  >>=? fun operation ->
  Block.bake ~operation b
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Apply.Invalid_double_endorsement_evidence ->
          true
      | _ ->
          false)

(** Check that a double endorsement added at the same time as a double
    endorsement operation fails. *)
let too_early_double_endorsement_evidence () =
  Context.init 2
  >>=? fun (b, _) ->
  block_fork b
  >>=? fun (blk_a, blk_b) ->
  Context.get_endorser (B blk_a)
  >>=? fun (delegate, _slots) ->
  Op.endorsement ~delegate (B blk_a) ()
  >>=? fun endorsement_a ->
  Op.endorsement ~delegate (B blk_b) ()
  >>=? fun endorsement_b ->
  Op.double_endorsement (B b) endorsement_a endorsement_b
  >>=? fun operation ->
  Block.bake ~operation b
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Apply.Too_early_double_endorsement_evidence _ ->
          true
      | _ ->
          false)

(** Check that after [preserved_cycles + 1], it is not possible
    to create a double_endorsement anymore. *)
let too_late_double_endorsement_evidence () =
  Context.init 2
  >>=? fun (b, _) ->
  Context.get_constants (B b)
  >>=? fun Constants.{parametric = {preserved_cycles; _}; _} ->
  block_fork b
  >>=? fun (blk_a, blk_b) ->
  Context.get_endorser (B blk_a)
  >>=? fun (delegate, _slots) ->
  Op.endorsement ~delegate (B blk_a) ()
  >>=? fun endorsement_a ->
  Op.endorsement ~delegate (B blk_b) ()
  >>=? fun endorsement_b ->
  fold_left_s
    (fun blk _ -> Block.bake_until_cycle_end blk)
    blk_a
    (1 -- (preserved_cycles + 1))
  >>=? fun blk ->
  Op.double_endorsement (B blk) endorsement_a endorsement_b
  >>=? fun operation ->
  Block.bake ~operation blk
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Apply.Outdated_double_endorsement_evidence _ ->
          true
      | _ ->
          false)

(** Check that an invalid double endorsement evidence that expose two
    endorsements made by two different endorsers fails. *)
let different_delegates () =
  Context.init 2
  >>=? fun (b, _) ->
  Block.bake b
  >>=? fun b ->
  block_fork b
  >>=? fun (blk_a, blk_b) ->
  Context.get_endorser (B blk_a)
  >>=? fun (endorser_a, _a_slots) ->
  get_first_different_endorsers (B blk_b)
  >>=? fun (endorser_b1c, endorser_b2c) ->
  let endorser_b =
    if Signature.Public_key_hash.( = ) endorser_a endorser_b1c.delegate then
      endorser_b2c.delegate
    else endorser_b1c.delegate
  in
  Op.endorsement ~delegate:endorser_a (B blk_a) ()
  >>=? fun e_a ->
  Op.endorsement ~delegate:endorser_b (B blk_b) ()
  >>=? fun e_b ->
  Block.bake ~operation:(Operation.pack e_b) blk_b
  >>=? fun _ ->
  Op.double_endorsement (B blk_b) e_a e_b
  >>=? fun operation ->
  Block.bake ~operation blk_b
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Apply.Inconsistent_double_endorsement_evidence _ ->
          true
      | _ ->
          false)

(** Check that a double endorsement evidence that exposes a ill-formed
    endorsement fails. *)
let wrong_delegate () =
  Context.init ~endorsers_per_block:1 2
  >>=? fun (b, contracts) ->
  Error_monad.map_s (Context.Contract.manager (B b)) contracts
  >>=? fun accounts ->
  let pkh1 = (List.nth accounts 0).Account.pkh in
  let pkh2 = (List.nth accounts 1).Account.pkh in
  block_fork b
  >>=? fun (blk_a, blk_b) ->
  Context.get_endorser (B blk_a)
  >>=? fun (endorser_a, _a_slots) ->
  Op.endorsement ~delegate:endorser_a (B blk_a) ()
  >>=? fun endorsement_a ->
  Context.get_endorser (B blk_b)
  >>=? fun (endorser_b, _b_slots) ->
  let delegate =
    if Signature.Public_key_hash.equal pkh1 endorser_b then pkh2 else pkh1
  in
  Op.endorsement ~delegate (B blk_b) ()
  >>=? fun endorsement_b ->
  Op.double_endorsement (B blk_b) endorsement_a endorsement_b
  >>=? fun operation ->
  Block.bake ~operation blk_b
  >>= fun e ->
  Assert.proto_error ~loc:__LOC__ e (function
      | Baking.Unexpected_endorsement ->
          true
      | _ ->
          false)

let tests =
  [ Test.tztest
      "valid double endorsement evidence"
      `Quick
      valid_double_endorsement_evidence;
    Test.tztest
      "invalid double endorsement evidence"
      `Quick
      invalid_double_endorsement;
    Test.tztest
      "too early double endorsement evidence"
      `Quick
      too_early_double_endorsement_evidence;
    Test.tztest
      "too late double endorsement evidence"
      `Quick
      too_late_double_endorsement_evidence;
    Test.tztest "different delegates" `Quick different_delegates;
    Test.tztest "wrong delegate" `Quick wrong_delegate ]
double_endorsement_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Protocol.

Import Alpha_context.

Definition get_first_different_baker {A B : Type}
  (baker :
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (bakers : A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
  op_atat __return
    (op_startypeminuserrorstar
      (fun baker' => Signature.Public_key_hash.op_ltgt baker baker') bakers).

Definition get_first_different_bakers {A B : Type} (ctxt : A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
        * B)) :=
  op_gtgteqquestion (op_startypeminuserrorstar ctxt)
    (fun bakers =>
      let baker_1 := List.hd bakers in
      op_gtgteqquestion (get_first_different_baker baker_1 (List.tl bakers))
        (fun baker_2 => __return (baker_1, baker_2))).

Definition get_first_different_endorsers {A B : Type} (ctxt : A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult (B * B)) :=
  op_gtgteqquestion (op_startypeminuserrorstar ctxt)
    (fun endorsers =>
      let endorser_1 := List.hd endorsers in
      let endorser_2 := List.hd (List.tl endorsers) in
      __return (endorser_1, endorser_2)).

Definition block_fork {A B C : Type} (b : A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult (B * C)) :=
  op_gtgteqquestion (get_first_different_bakers op_startypeminuserrorstar)
    (fun function_parameter =>
      let '(baker_1, baker_2) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar b)
        (fun blk_a =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar b)
            (fun blk_b => __return (blk_a, blk_b)))).

Definition valid_double_endorsement_evidence (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion (block_fork b)
        (fun function_parameter =>
          let '(blk_a, blk_b) := function_parameter in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar)
            (fun function_parameter =>
              let '(delegate, _slots) := function_parameter in
              op_gtgteqquestion
                (op_startypeminuserrorstar delegate op_startypeminuserrorstar tt)
                (fun endorsement_a =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar delegate
                      op_startypeminuserrorstar tt)
                    (fun endorsement_b =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar
                          (cons (Operation.pack endorsement_a) []) blk_a)
                        (fun blk_a =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar op_startypeminuserrorstar
                              endorsement_a endorsement_b)
                            (fun operation =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar
                                  op_startypeminuserrorstar)
                                (fun bakers =>
                                  op_gtgteqquestion
                                    (get_first_different_baker delegate bakers)
                                    (fun baker =>
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar
                                          op_startypeminuserrorstar operation
                                          blk_a)
                                        (fun blk =>
                                          iter_s
                                            (fun kind =>
                                              let contract :=
                                                Alpha_context.Contract.implicit_contract
                                                  delegate in
                                              op_startypeminuserrorstar __LOC__
                                                op_startypeminuserrorstar
                                                contract kind Tez.zero)
                                            (cons op_startypeminuserrorstar
                                              (cons op_startypeminuserrorstar
                                                (cons op_startypeminuserrorstar
                                                  []))))))))))))).

Definition invalid_double_endorsement {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 10)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun b =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar tt)
            (fun endorsement =>
              op_gtgteqquestion
                (op_startypeminuserrorstar (Operation.pack endorsement) b)
                (fun b =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      endorsement endorsement)
                    (fun operation =>
                      op_gtgteq (op_startypeminuserrorstar operation b)
                        (fun res =>
                          op_startypeminuserrorstar __LOC__ res
                            (fun function_parameter =>
                              match function_parameter with
                              |
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_double_endorsement_evidence
                                => true
                              | _ => false
                              end))))))).

Definition too_early_double_endorsement_evidence {A : Type}
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion (block_fork b)
        (fun function_parameter =>
          let '(blk_a, blk_b) := function_parameter in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar)
            (fun function_parameter =>
              let '(delegate, _slots) := function_parameter in
              op_gtgteqquestion
                (op_startypeminuserrorstar delegate op_startypeminuserrorstar tt)
                (fun endorsement_a =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar delegate
                      op_startypeminuserrorstar tt)
                    (fun endorsement_b =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          endorsement_a endorsement_b)
                        (fun operation =>
                          op_gtgteq (op_startypeminuserrorstar operation b)
                            (fun res =>
                              op_startypeminuserrorstar __LOC__ res
                                (fun function_parameter =>
                                  match function_parameter with
                                  |
                                    Tezos_protocol_environment_alpha__Environment.Error_monad.Too_early_double_endorsement_evidence
                                      _ => true
                                  | _ => false
                                  end)))))))).

Definition too_late_double_endorsement_evidence {A : Type}
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
        (fun function_parameter =>
          let '{| parametric := {| preserved_cycles := preserved_cycles |} |} :=
            function_parameter in
          op_gtgteqquestion (block_fork b)
            (fun function_parameter =>
              let '(blk_a, blk_b) := function_parameter in
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar)
                (fun function_parameter =>
                  let '(delegate, _slots) := function_parameter in
                  op_gtgteqquestion
                    (op_startypeminuserrorstar delegate
                      op_startypeminuserrorstar tt)
                    (fun endorsement_a =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar delegate
                          op_startypeminuserrorstar tt)
                        (fun endorsement_b =>
                          op_gtgteqquestion
                            (fold_left_s
                              (fun blk =>
                                fun function_parameter =>
                                  let '_ := function_parameter in
                                  op_startypeminuserrorstar blk) blk_a
                              (op_startypeminuserrorstar 1
                                (op_plus preserved_cycles 1)))
                            (fun blk =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar
                                  op_startypeminuserrorstar endorsement_a
                                  endorsement_b)
                                (fun operation =>
                                  op_gtgteq
                                    (op_startypeminuserrorstar operation blk)
                                    (fun res =>
                                      op_startypeminuserrorstar __LOC__ res
                                        (fun function_parameter =>
                                          match function_parameter with
                                          |
                                            Tezos_protocol_environment_alpha__Environment.Error_monad.Outdated_double_endorsement_evidence
                                              _ => true
                                          | _ => false
                                          end)))))))))).

Definition different_delegates {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun b =>
          op_gtgteqquestion (block_fork b)
            (fun function_parameter =>
              let '(blk_a, blk_b) := function_parameter in
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar)
                (fun function_parameter =>
                  let '(endorser_a, _a_slots) := function_parameter in
                  op_gtgteqquestion
                    (get_first_different_endorsers op_startypeminuserrorstar)
                    (fun function_parameter =>
                      let '(endorser_b1c, endorser_b2c) := function_parameter in
                      let endorser_b :=
                        if
                          Signature.Public_key_hash.op_eq endorser_a
                            (delegate endorser_b1c) then
                          delegate endorser_b2c
                        else
                          delegate endorser_b1c in
                      op_gtgteqquestion
                        (op_startypeminuserrorstar endorser_a
                          op_startypeminuserrorstar tt)
                        (fun e_a =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar endorser_b
                              op_startypeminuserrorstar tt)
                            (fun e_b =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar (Operation.pack e_b)
                                  blk_b)
                                (fun function_parameter =>
                                  let '_ := function_parameter in
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar
                                      op_startypeminuserrorstar e_a e_b)
                                    (fun operation =>
                                      op_gtgteq
                                        (op_startypeminuserrorstar operation
                                          blk_b)
                                        (fun res =>
                                          op_startypeminuserrorstar __LOC__ res
                                            (fun function_parameter =>
                                              match function_parameter with
                                              |
                                                Tezos_protocol_environment_alpha__Environment.Error_monad.Inconsistent_double_endorsement_evidence
                                                  _ => true
                                              | _ => false
                                              end))))))))))).

Definition wrong_delegate {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1 2)
    (fun function_parameter =>
      let '(b, contracts) := function_parameter in
      op_gtgteqquestion
        (Error_monad.map_s (op_startypeminuserrorstar op_startypeminuserrorstar)
          contracts)
        (fun accounts =>
          let pkh1 := Account.pkh (op_startypeminuserrorstar accounts 0) in
          let pkh2 := Account.pkh (op_startypeminuserrorstar accounts 1) in
          op_gtgteqquestion (block_fork b)
            (fun function_parameter =>
              let '(blk_a, blk_b) := function_parameter in
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar)
                (fun function_parameter =>
                  let '(endorser_a, _a_slots) := function_parameter in
                  op_gtgteqquestion
                    (op_startypeminuserrorstar endorser_a
                      op_startypeminuserrorstar tt)
                    (fun endorsement_a =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar)
                        (fun function_parameter =>
                          let '(endorser_b, _b_slots) := function_parameter in
                          let delegate :=
                            if Signature.Public_key_hash.equal pkh1 endorser_b
                              then
                              pkh2
                            else
                              pkh1 in
                          op_gtgteqquestion
                            (op_startypeminuserrorstar delegate
                              op_startypeminuserrorstar tt)
                            (fun endorsement_b =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar
                                  op_startypeminuserrorstar endorsement_a
                                  endorsement_b)
                                (fun operation =>
                                  op_gtgteq
                                    (op_startypeminuserrorstar operation blk_b)
                                    (fun e =>
                                      op_startypeminuserrorstar __LOC__ e
                                        (fun function_parameter =>
                                          match function_parameter with
                                          |
                                            Tezos_protocol_environment_alpha__Environment.Error_monad.Unexpected_endorsement
                                            => true
                                          | _ => false
                                          end)))))))))).

Definition tests {A : Type} : list A :=
  cons
    (op_startypeminuserrorstar "valid double endorsement evidence" % string
      (* ❌ Variants not supported *)
      variant valid_double_endorsement_evidence)
    (cons
      (op_startypeminuserrorstar "invalid double endorsement evidence" % string
        (* ❌ Variants not supported *)
        variant invalid_double_endorsement)
      (cons
        (op_startypeminuserrorstar
          "too early double endorsement evidence" % string
          (* ❌ Variants not supported *)
          variant too_early_double_endorsement_evidence)
        (cons
          (op_startypeminuserrorstar
            "too late double endorsement evidence" % string
            (* ❌ Variants not supported *)
            variant too_late_double_endorsement_evidence)
          (cons
            (op_startypeminuserrorstar "different delegates" % string
              (* ❌ Variants not supported *)
              variant different_delegates)
            (cons
              (op_startypeminuserrorstar "wrong delegate" % string
                (* ❌ Variants not supported *)
                variant wrong_delegate) []))))).
test/endorsement.ml 253 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Endorsing a block adds an extra layer of confidence to the Tezos's
    PoS algorithm. The block endorsing operation must be included in
    the following block. Each endorser possess a number of slots
    corresponding to their priority. After [preserved_cycles], a reward
    is given to the endorser. This reward depends on the priority of
    the block that contains the endorsements. *)

open Protocol
open Alpha_context
open Test_utils
open Test_tez

(****************************************************************)
(*                    Utility functions                         *)
(****************************************************************)

let get_expected_reward ctxt ~priority ~baker ~endorsing_power =
  ( if baker then Context.get_baking_reward ctxt ~priority ~endorsing_power
  else return (Test_tez.Tez.of_int 0) )
  >>=? fun baking_reward ->
  Context.get_endorsing_reward ctxt ~priority ~endorsing_power
  >>=? fun endorsing_reward ->
  Test_tez.Tez.(endorsing_reward +? baking_reward)
  >>?= fun reward -> return reward

let get_expected_deposit ctxt ~baker ~endorsing_power =
  Context.get_constants ctxt
  >>=? fun Constants.
             { parametric =
                 {endorsement_security_deposit; block_security_deposit; _};
               _ } ->
  let open Environment in
  let open Tez in
  let baking_deposit = if baker then block_security_deposit else of_int 0 in
  endorsement_security_deposit *? Int64.of_int endorsing_power
  >>?= fun endorsement_deposit ->
  endorsement_deposit +? baking_deposit >>?= fun deposit -> return deposit

(* [baker] is true if the [pkh] has also baked the current block, in
   which case correspoding deposit and reward should be ajusted *)
let assert_endorser_balance_consistency ~loc ?(priority = 0) ?(baker = false)
    ~endorsing_power ctxt pkh initial_balance =
  let contract = Contract.implicit_contract pkh in
  get_expected_reward ctxt ~priority ~baker ~endorsing_power
  >>=? fun reward ->
  get_expected_deposit ctxt ~baker ~endorsing_power
  >>=? fun deposit ->
  Assert.balance_was_debited ~loc ctxt contract initial_balance deposit
  >>=? fun () ->
  Context.Contract.balance ~kind:Rewards ctxt contract
  >>=? fun reward_balance ->
  Assert.equal_tez ~loc reward_balance reward
  >>=? fun () ->
  Context.Contract.balance ~kind:Deposit ctxt contract
  >>=? fun deposit_balance -> Assert.equal_tez ~loc deposit_balance deposit

let delegates_with_slots endorsers =
  List.map
    (fun (endorser : Delegate_services.Endorsing_rights.t) ->
      endorser.delegate)
    endorsers

let endorsing_power endorsers =
  List.fold_left
    (fun sum (endorser : Delegate_services.Endorsing_rights.t) ->
      sum + List.length endorser.slots)
    0
    endorsers

(****************************************************************)
(*                      Tests                                   *)
(****************************************************************)

(** Apply a single endorsement from the slot 0 endorser *)
let simple_endorsement () =
  Context.init 5
  >>=? fun (b, _) ->
  Context.get_endorser (B b)
  >>=? fun (delegate, slots) ->
  Op.endorsement ~delegate (B b) ()
  >>=? fun op ->
  Context.Contract.balance (B b) (Contract.implicit_contract delegate)
  >>=? fun initial_balance ->
  let policy = Block.Excluding [delegate] in
  Block.get_next_baker ~policy b
  >>=? fun (_, priority, _) ->
  Block.bake ~policy ~operations:[Operation.pack op] b
  >>=? fun b2 ->
  assert_endorser_balance_consistency
    ~loc:__LOC__
    (B b2)
    ~priority
    ~endorsing_power:(List.length slots)
    delegate
    initial_balance

(** Apply a maximum number of endorsements. An endorser can be
    selected twice. *)
let max_endorsement () =
  let endorsers_per_block = 16 in
  Context.init ~endorsers_per_block 32
  >>=? fun (b, _) ->
  Context.get_endorsers (B b)
  >>=? fun endorsers ->
  Assert.equal_int
    ~loc:__LOC__
    (List.length
       (List.concat
          (List.map
             (fun {Alpha_services.Delegate.Endorsing_rights.slots; _} -> slots)
             endorsers)))
    endorsers_per_block
  >>=? fun () ->
  fold_left_s
    (fun (delegates, ops, balances)
         (endorser : Alpha_services.Delegate.Endorsing_rights.t) ->
      let delegate = endorser.delegate in
      Context.Contract.balance (B b) (Contract.implicit_contract delegate)
      >>=? fun balance ->
      Op.endorsement ~delegate (B b) ()
      >>=? fun op ->
      return
        ( delegate :: delegates,
          Operation.pack op :: ops,
          (List.length endorser.slots, balance) :: balances ))
    ([], [], [])
    endorsers
  >>=? fun (delegates, ops, previous_balances) ->
  Block.bake ~policy:(Excluding delegates) ~operations:(List.rev ops) b
  >>=? fun b ->
  (* One account can endorse more than one time per level, we must
     check that the bonds are summed up *)
  iter_s
    (fun (endorser_account, (endorsing_power, previous_balance)) ->
      assert_endorser_balance_consistency
        ~loc:__LOC__
        (B b)
        ~endorsing_power
        endorser_account
        previous_balance)
    (List.combine delegates previous_balances)

(** Check every that endorsers' balances are consistent with different priorities *)
let consistent_priorities () =
  let priorities = 0 -- 64 in
  Context.init 64
  >>=? fun (b, _) ->
  fold_left_s
    (fun (b, used_pkhes) priority ->
      (* Choose an endorser that has not baked nor endorsed before *)
      Context.get_endorsers (B b)
      >>=? fun endorsers ->
      let endorser =
        List.find_opt
          (fun (e : Delegate_services.Endorsing_rights.t) ->
            not (Signature.Public_key_hash.Set.mem e.delegate used_pkhes))
          endorsers
      in
      match endorser with
      | None ->
          return (b, used_pkhes) (* not enough fresh endorsers; we "stop" *)
      | Some endorser ->
          Context.Contract.balance
            (B b)
            (Contract.implicit_contract endorser.delegate)
          >>=? fun balance ->
          Op.endorsement ~delegate:endorser.delegate (B b) ()
          >>=? fun operation ->
          let operation = Operation.pack operation in
          Block.get_next_baker ~policy:(By_priority priority) b
          >>=? fun (baker, _, _) ->
          let used_pkhes =
            Signature.Public_key_hash.Set.add baker used_pkhes
          in
          let used_pkhes =
            Signature.Public_key_hash.Set.add endorser.delegate used_pkhes
          in
          (* Bake with a specific priority *)
          Block.bake ~policy:(By_priority priority) ~operation b
          >>=? fun b ->
          let is_baker =
            Signature.Public_key_hash.(baker = endorser.delegate)
          in
          assert_endorser_balance_consistency
            ~loc:__LOC__
            ~priority
            ~baker:is_baker
            (B b)
            ~endorsing_power:(List.length endorser.slots)
            endorser.delegate
            balance
          >>=? fun () -> return (b, used_pkhes))
    (b, Signature.Public_key_hash.Set.empty)
    priorities
  >>=? fun _b -> return_unit

(** Check that after [preserved_cycles] cycles the endorser gets his reward *)
let reward_retrieval () =
  Context.init 5
  >>=? fun (b, _) ->
  Context.get_constants (B b)
  >>=? fun Constants.{parametric = {preserved_cycles; _}; _} ->
  Context.get_endorser (B b)
  >>=? fun (endorser, slots) ->
  Context.Contract.balance (B b) (Contract.implicit_contract endorser)
  >>=? fun balance ->
  Op.endorsement ~delegate:endorser (B b) ()
  >>=? fun operation ->
  let operation = Operation.pack operation in
  let policy = Block.Excluding [endorser] in
  Block.get_next_baker ~policy b
  >>=? fun (_, priority, _) ->
  Block.bake ~policy ~operation b
  >>=? fun b ->
  (* Bake (preserved_cycles + 1) cycles *)
  fold_left_s
    (fun b _ -> Block.bake_until_cycle_end ~policy:(Excluding [endorser]) b)
    b
    (0 -- preserved_cycles)
  >>=? fun b ->
  get_expected_reward
    (B b)
    ~priority
    ~baker:false
    ~endorsing_power:(List.length slots)
  >>=? fun reward ->
  Assert.balance_was_credited
    ~loc:__LOC__
    (B b)
    (Contract.implicit_contract endorser)
    balance
    reward

(** Check that after [preserved_cycles] cycles endorsers get their
    reward. Two endorsers are used and they endorse in different
    cycles. *)
let reward_retrieval_two_endorsers () =
  Context.init 5
  >>=? fun (b, _) ->
  Context.get_constants (B b)
  >>=? fun Constants.
             { parametric =
                 { preserved_cycles;
                   endorsement_reward;
                   endorsement_security_deposit;
                   _ };
               _ } ->
  Context.get_endorsers (B b)
  >>=? fun endorsers ->
  let endorser1 = List.hd endorsers in
  let endorser2 = List.hd (List.tl endorsers) in
  Context.Contract.balance
    (B b)
    (Contract.implicit_contract endorser1.delegate)
  >>=? fun balance1 ->
  Context.Contract.balance
    (B b)
    (Contract.implicit_contract endorser2.delegate)
  >>=? fun balance2 ->
  Lwt.return
    Tez.(
      endorsement_security_deposit
      *? Int64.of_int (List.length endorser1.slots))
  >>=? fun security_deposit1 ->
  (* endorser1 endorses the genesis block in cycle 0 *)
  Op.endorsement ~delegate:endorser1.delegate (B b) ()
  >>=? fun operation1 ->
  let policy = Block.Excluding [endorser1.delegate; endorser2.delegate] in
  Block.get_next_baker ~policy b
  >>=? fun (_, priority, _) ->
  Tez.(endorsement_reward /? Int64.(succ (of_int priority)))
  >>?= fun reward_per_slot ->
  Lwt.return
    Tez.(reward_per_slot *? Int64.of_int (List.length endorser1.slots))
  >>=? fun reward1 ->
  (* bake next block, include endorsement of endorser1 *)
  Block.bake ~policy ~operation:(Operation.pack operation1) b
  >>=? fun b ->
  Assert.balance_was_debited
    ~loc:__LOC__
    (B b)
    (Contract.implicit_contract endorser1.delegate)
    balance1
    security_deposit1
  >>=? fun () ->
  Assert.balance_is
    ~loc:__LOC__
    (B b)
    (Contract.implicit_contract endorser2.delegate)
    balance2
  >>=? fun () ->
  (* complete cycle 0 *)
  Block.bake_until_cycle_end ~policy b
  >>=? fun b ->
  Assert.balance_was_debited
    ~loc:__LOC__
    (B b)
    (Contract.implicit_contract endorser1.delegate)
    balance1
    security_deposit1
  >>=? fun () ->
  Assert.balance_is
    ~loc:__LOC__
    (B b)
    (Contract.implicit_contract endorser2.delegate)
    balance2
  >>=? fun () ->
  (* get the slots of endorser2 for the current block *)
  Context.get_endorsers (B b)
  >>=? fun endorsers ->
  let same_endorser2 endorser =
    Signature.Public_key_hash.(
      endorser.Delegate_services.Endorsing_rights.delegate = endorser2.delegate)
  in
  let endorser2 = List.find same_endorser2 endorsers in
  (* No exception raised: in sandboxed mode endorsers do not change between blocks *)
  Lwt.return
    Tez.(
      endorsement_security_deposit
      *? Int64.of_int (List.length endorser2.slots))
  >>=? fun security_deposit2 ->
  (* endorser2 endorses the last block in cycle 0 *)
  Op.endorsement ~delegate:endorser2.delegate (B b) ()
  >>=? fun operation2 ->
  (* bake first block in cycle 1, include endorsement of endorser2 *)
  Block.bake ~policy ~operation:(Operation.pack operation2) b
  >>=? fun b ->
  let priority = b.header.protocol_data.contents.priority in
  Tez.(endorsement_reward /? Int64.(succ (of_int priority)))
  >>?= fun reward_per_slot ->
  Lwt.return
    Tez.(reward_per_slot *? Int64.of_int (List.length endorser2.slots))
  >>=? fun reward2 ->
  Assert.balance_was_debited
    ~loc:__LOC__
    (B b)
    (Contract.implicit_contract endorser1.delegate)
    balance1
    security_deposit1
  >>=? fun () ->
  Assert.balance_was_debited
    ~loc:__LOC__
    (B b)
    (Contract.implicit_contract endorser2.delegate)
    balance2
    security_deposit2
  >>=? fun () ->
  (* bake [preserved_cycles] cycles *)
  fold_left_s
    (fun b _ ->
      Assert.balance_was_debited
        ~loc:__LOC__
        (B b)
        (Contract.implicit_contract endorser1.delegate)
        balance1
        security_deposit1
      >>=? fun () ->
      Assert.balance_was_debited
        ~loc:__LOC__
        (B b)
        (Contract.implicit_contract endorser2.delegate)
        balance2
        security_deposit2
      >>=? fun () -> Block.bake_until_cycle_end ~policy b)
    b
    (1 -- preserved_cycles)
  >>=? fun b ->
  Assert.balance_was_credited
    ~loc:__LOC__
    (B b)
    (Contract.implicit_contract endorser1.delegate)
    balance1
    reward1
  >>=? fun () ->
  Assert.balance_was_debited
    ~loc:__LOC__
    (B b)
    (Contract.implicit_contract endorser2.delegate)
    balance2
    security_deposit2
  >>=? fun () ->
  (* bake cycle [preserved_cycle + 1] *)
  Block.bake_until_cycle_end ~policy b
  >>=? fun b ->
  Assert.balance_was_credited
    ~loc:__LOC__
    (B b)
    (Contract.implicit_contract endorser1.delegate)
    balance1
    reward1
  >>=? fun () ->
  Assert.balance_was_credited
    ~loc:__LOC__
    (B b)
    (Contract.implicit_contract endorser2.delegate)
    balance2
    reward2

(****************************************************************)
(*  The following test scenarios are supposed to raise errors.  *)
(****************************************************************)

(** Wrong endorsement predecessor : apply an endorsement with an
    incorrect block predecessor *)
let wrong_endorsement_predecessor () =
  Context.init 5
  >>=? fun (b, _) ->
  Context.get_endorser (B b)
  >>=? fun (genesis_endorser, _slots) ->
  Block.bake b
  >>=? fun b' ->
  Op.endorsement ~delegate:genesis_endorser ~signing_context:(B b) (B b') ()
  >>=? fun operation ->
  let operation = Operation.pack operation in
  Block.bake ~operation b'
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Apply.Wrong_endorsement_predecessor _ ->
          true
      | _ ->
          false)

(** Invalid_endorsement_level : apply an endorsement with an incorrect
    level (i.e. the predecessor level) *)
let invalid_endorsement_level () =
  Context.init 5
  >>=? fun (b, _) ->
  Context.get_level (B b)
  >>=? fun genesis_level ->
  Block.bake b
  >>=? fun b ->
  Op.endorsement ~level:genesis_level (B b) ()
  >>=? fun operation ->
  let operation = Operation.pack operation in
  Block.bake ~operation b
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Apply.Invalid_endorsement_level ->
          true
      | _ ->
          false)

(** Duplicate endorsement : apply an endorsement that has already been done *)
let duplicate_endorsement () =
  Context.init 5
  >>=? fun (b, _) ->
  Incremental.begin_construction b
  >>=? fun inc ->
  Op.endorsement (B b) ()
  >>=? fun operation ->
  let operation = Operation.pack operation in
  Incremental.add_operation inc operation
  >>=? fun inc ->
  Op.endorsement (B b) ()
  >>=? fun operation ->
  let operation = Operation.pack operation in
  Incremental.add_operation inc operation
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Apply.Duplicate_endorsement _ ->
          true
      | _ ->
          false)

(** Apply a single endorsement from the slot 0 endorser *)
let not_enough_for_deposit () =
  Context.init 5 ~endorsers_per_block:1
  >>=? fun (b_init, contracts) ->
  Error_monad.map_s
    (fun c ->
      Context.Contract.manager (B b_init) c >>=? fun m -> return (m, c))
    contracts
  >>=? fun managers ->
  Block.bake b_init
  >>=? fun b ->
  (* retrieve the level 2's endorser *)
  Context.get_endorser (B b)
  >>=? fun (endorser, _slots) ->
  let (_, contract_other_than_endorser) =
    List.find
      (fun (c, _) ->
        not (Signature.Public_key_hash.equal c.Account.pkh endorser))
      managers
  in
  let (_, contract_of_endorser) =
    List.find
      (fun (c, _) -> Signature.Public_key_hash.equal c.Account.pkh endorser)
      managers
  in
  Context.Contract.balance (B b) (Contract.implicit_contract endorser)
  >>=? fun initial_balance ->
  (* Empty the future endorser account *)
  Op.transaction
    (B b_init)
    contract_of_endorser
    contract_other_than_endorser
    initial_balance
  >>=? fun op_trans ->
  Block.bake ~operation:op_trans b_init
  >>=? fun b ->
  (* Endorse with a zero balance *)
  Op.endorsement ~delegate:endorser (B b) ()
  >>=? fun op_endo ->
  Block.bake
    ~policy:(Excluding [endorser])
    ~operation:(Operation.pack op_endo)
    b
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Delegate_storage.Balance_too_low_for_deposit _ ->
          true
      | _ ->
          false)

(* check that a block with not enough endorsement cannot be baked *)
let endorsement_threshold () =
  let initial_endorsers = 28 in
  let num_accounts = 100 in
  Context.init ~initial_endorsers num_accounts
  >>=? fun (b, _) ->
  Context.get_endorsers (B b)
  >>=? fun endorsers ->
  let num_endorsers = List.length endorsers in
  (* we try to bake with more and more endorsers, but at each
     iteration with a timestamp smaller than required *)
  iter_s
    (fun i ->
      (* the priority is chosen rather arbitrarily *)
      let priority = num_endorsers - i in
      let crt_endorsers = List.take_n i endorsers in
      let endorsing_power = endorsing_power crt_endorsers in
      let delegates = delegates_with_slots crt_endorsers in
      map_s (fun x -> Op.endorsement ~delegate:x (B b) ()) delegates
      >>=? fun ops ->
      Context.get_minimal_valid_time (B b) ~priority ~endorsing_power
      >>=? fun timestamp ->
      (* decrease the timestamp by one second *)
      let seconds =
        Int64.(sub (of_string (Timestamp.to_seconds_string timestamp)) 1L)
      in
      match Timestamp.of_seconds (Int64.to_string seconds) with
      | None ->
          failwith "timestamp to/from string manipulation failed"
      | Some timestamp ->
          Block.bake
            ~timestamp
            ~policy:(By_priority priority)
            ~operations:(List.map Operation.pack ops)
            b
          >>= fun b2 ->
          Assert.proto_error ~loc:__LOC__ b2 (function
              | Baking.Timestamp_too_early _
              | Apply.Not_enough_endorsements_for_priority _ ->
                  true
              | _ ->
                  false))
    (0 -- (num_endorsers - 1))
  >>=? fun () ->
  (* we bake with all endorsers endorsing, at the right time *)
  let priority = 0 in
  let endorsing_power = endorsing_power endorsers in
  let delegates = delegates_with_slots endorsers in
  map_s (fun delegate -> Op.endorsement ~delegate (B b) ()) delegates
  >>=? fun ops ->
  Context.get_minimal_valid_time (B b) ~priority ~endorsing_power
  >>=? fun timestamp ->
  Block.bake
    ~policy:(By_priority priority)
    ~timestamp
    ~operations:(List.map Operation.pack ops)
    b
  >>= fun _ -> return_unit

let test_fitness_gap () =
  let num_accounts = 5 in
  Context.init num_accounts
  >>=? fun (b, _) ->
  ( match Fitness_repr.to_int64 b.header.shell.fitness with
  | Ok fitness ->
      return (Int64.to_int fitness)
  | Error _ ->
      assert false )
  >>=? fun fitness ->
  Context.get_endorser (B b)
  >>=? fun (delegate, _slots) ->
  Op.endorsement ~delegate (B b) ()
  >>=? fun op ->
  (* bake at priority 0 succeed thanks to enough endorsements *)
  Block.bake ~policy:(By_priority 0) ~operations:[Operation.pack op] b
  >>=? fun b ->
  ( match Fitness_repr.to_int64 b.header.shell.fitness with
  | Ok new_fitness ->
      return (Int64.to_int new_fitness - fitness)
  | Error _ ->
      assert false )
  >>=? fun res ->
  (* in Emmy+, the fitness increases by 1, so the difference between
     the fitness at level 1 and at level 0 is 1, independently if the
     number fo endorements (here 1) *)
  Assert.equal_int ~loc:__LOC__ res 1 >>=? fun () -> return_unit

let tests =
  [ Test.tztest "Simple endorsement" `Quick simple_endorsement;
    Test.tztest "Maximum endorsement" `Quick max_endorsement;
    Test.tztest "Consistent priorities" `Quick consistent_priorities;
    Test.tztest "Reward retrieval" `Quick reward_retrieval;
    Test.tztest
      "Reward retrieval two endorsers"
      `Quick
      reward_retrieval_two_endorsers;
    Test.tztest "Endorsement threshold" `Quick endorsement_threshold;
    Test.tztest "Fitness gap" `Quick test_fitness_gap;
    (* Fail scenarios *)
    Test.tztest
      "Wrong endorsement predecessor"
      `Quick
      wrong_endorsement_predecessor;
    Test.tztest "Invalid endorsement level" `Quick invalid_endorsement_level;
    Test.tztest "Duplicate endorsement" `Quick duplicate_endorsement;
    Test.tztest "Not enough for deposit" `Quick not_enough_for_deposit ]
endorsement_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Protocol.

Import Alpha_context.

Definition get_expected_reward {A B C D : Type}
  (ctxt : A) (priority : B) (baker : bool) (endorsing_power : C)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult D) :=
  op_gtgteqquestion
    (if baker then
      op_startypeminuserrorstar ctxt priority endorsing_power
    else
      __return (op_startypeminuserrorstar 0))
    (fun baking_reward =>
      op_gtgteqquestion
        (op_startypeminuserrorstar ctxt priority endorsing_power)
        (fun endorsing_reward =>
          op_startypeminuserrorstar op_startypeminuserrorstar
            (fun reward => __return reward))).

Definition get_expected_deposit {A B : Type}
  (ctxt : A) (baker : bool) (endorsing_power : Z)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
  op_gtgteqquestion (op_startypeminuserrorstar ctxt)
    (fun function_parameter =>
      let '{|
        parametric := {|
          block_security_deposit := block_security_deposit;
            endorsement_security_deposit := endorsement_security_deposit
            |}
          |} := function_parameter in
      let baking_deposit :=
        if baker then
          block_security_deposit
        else
          op_startypeminuserrorstar 0 in
      op_startypeminuserrorstar
        (op_starquestion endorsement_security_deposit
          (Int64.of_int endorsing_power))
        (fun endorsement_deposit =>
          op_startypeminuserrorstar
            (op_plusquestion endorsement_deposit baking_deposit)
            (fun deposit => __return deposit))).

Definition assert_endorser_balance_consistency {A B C D : Type}
  (loc : A) (op_staroptstar : option Z)
  : option bool ->
    Z ->
      B ->
        Tezos_raw_protocol_alpha__Alpha_context.public_key_hash ->
          C ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                D) :=
  let priority :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => 0
    end in
  fun op_staroptstar =>
    let baker :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => false
      end in
    fun endorsing_power =>
      fun ctxt =>
        fun pkh =>
          fun initial_balance =>
            let contract := Contract.implicit_contract pkh in
            op_gtgteqquestion
              (get_expected_reward ctxt priority baker endorsing_power)
              (fun reward =>
                op_gtgteqquestion
                  (get_expected_deposit ctxt baker endorsing_power)
                  (fun deposit =>
                    op_gtgteqquestion
                      (op_startypeminuserrorstar loc ctxt contract
                        initial_balance deposit)
                      (fun function_parameter =>
                        let 'tt := function_parameter in
                        op_gtgteqquestion
                          (op_startypeminuserrorstar op_startypeminuserrorstar
                            ctxt contract)
                          (fun reward_balance =>
                            op_gtgteqquestion
                              (op_startypeminuserrorstar loc reward_balance
                                reward)
                              (fun function_parameter =>
                                let 'tt := function_parameter in
                                op_gtgteqquestion
                                  (op_startypeminuserrorstar
                                    op_startypeminuserrorstar ctxt contract)
                                  (fun deposit_balance =>
                                    op_startypeminuserrorstar loc
                                      deposit_balance deposit)))))).

Definition delegates_with_slots
  (endorsers :
    list Tezos_protocol_alpha.Protocol.Delegate_services.Endorsing_rights.t)
  : list
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t :=
  List.map (fun endorser => delegate endorser) endorsers.

Definition endorsing_power
  (endorsers :
    list Tezos_protocol_alpha.Protocol.Delegate_services.Endorsing_rights.t)
  : Z :=
  List.fold_left
    (fun sum => fun endorser => op_plus sum (List.length (slots endorser))) 0
    endorsers.

Definition simple_endorsement {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 5)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
        (fun function_parameter =>
          let '(delegate, slots) := function_parameter in
          op_gtgteqquestion
            (op_startypeminuserrorstar delegate op_startypeminuserrorstar tt)
            (fun op =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar
                  (Contract.implicit_contract delegate))
                (fun initial_balance =>
                  let policy := op_startypeminuserrorstar in
                  op_gtgteqquestion (op_startypeminuserrorstar policy b)
                    (fun function_parameter =>
                      let '(_, priority, _) := function_parameter in
                      op_gtgteqquestion
                        (op_startypeminuserrorstar policy
                          (cons (Operation.pack op) []) b)
                        (fun b2 =>
                          assert_endorser_balance_consistency __LOC__
                            (Some priority) None (List.length slots)
                            op_startypeminuserrorstar delegate initial_balance)))))).

Definition max_endorsement (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  let endorsers_per_block := 16 in
  op_gtgteqquestion (op_startypeminuserrorstar endorsers_per_block 32)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
        (fun endorsers =>
          op_gtgteqquestion
            (op_startypeminuserrorstar __LOC__
              (List.length
                (List.concat
                  (List.map
                    (fun function_parameter =>
                      let '{|
                        Alpha_services.Delegate.Endorsing_rights.slots := slots
                          |} := function_parameter in
                      slots) endorsers))) endorsers_per_block)
            (fun function_parameter =>
              let 'tt := function_parameter in
              op_gtgteqquestion
                (fold_left_s
                  (fun function_parameter =>
                    let '(delegates, ops, balances) := function_parameter in
                    fun endorser =>
                      let delegate := delegate endorser in
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          (Contract.implicit_contract delegate))
                        (fun balance =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar delegate
                              op_startypeminuserrorstar tt)
                            (fun op =>
                              __return
                                ((cons delegate delegates),
                                  (cons (Operation.pack op) ops),
                                  (cons
                                    ((List.length (slots endorser)), balance)
                                    balances))))) ([], [], []) endorsers)
                (fun function_parameter =>
                  let '(delegates, ops, previous_balances) := function_parameter
                    in
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      (List.rev ops) b)
                    (fun b =>
                      iter_s
                        (fun function_parameter =>
                          let
                            '(endorser_account,
                              (endorsing_power, previous_balance)) :=
                            function_parameter in
                          assert_endorser_balance_consistency __LOC__ None None
                            endorsing_power op_startypeminuserrorstar
                            endorser_account previous_balance)
                        (List.combine delegates previous_balances)))))).

Definition consistent_priorities (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  let priorities := op_startypeminuserrorstar 0 64 in
  op_gtgteqquestion (op_startypeminuserrorstar 64)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion
        (fold_left_s
          (fun function_parameter =>
            let '(b, used_pkhes) := function_parameter in
            fun priority =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar)
                (fun endorsers =>
                  let endorser :=
                    List.find_opt
                      (fun e =>
                        not
                          (Signature.Public_key_hash.Set.mem (delegate e)
                            used_pkhes)) endorsers in
                  match endorser with
                  | None => __return (b, used_pkhes)
                  | Some endorser =>
                    op_gtgteqquestion
                      (op_startypeminuserrorstar op_startypeminuserrorstar
                        (Contract.implicit_contract (delegate endorser)))
                      (fun balance =>
                        op_gtgteqquestion
                          (op_startypeminuserrorstar (delegate endorser)
                            op_startypeminuserrorstar tt)
                          (fun operation =>
                            let operation := Operation.pack operation in
                            op_gtgteqquestion
                              (op_startypeminuserrorstar
                                op_startypeminuserrorstar b)
                              (fun function_parameter =>
                                let '(baker, _, _) := function_parameter in
                                let used_pkhes :=
                                  Signature.Public_key_hash.Set.add baker
                                    used_pkhes in
                                let used_pkhes :=
                                  Signature.Public_key_hash.Set.add
                                    (delegate endorser) used_pkhes in
                                op_gtgteqquestion
                                  (op_startypeminuserrorstar
                                    op_startypeminuserrorstar operation b)
                                  (fun b =>
                                    let is_baker :=
                                      op_eq baker (delegate endorser) in
                                    op_gtgteqquestion
                                      (assert_endorser_balance_consistency
                                        __LOC__ (Some priority) (Some is_baker)
                                        (List.length (slots endorser))
                                        op_startypeminuserrorstar
                                        (delegate endorser) balance)
                                      (fun function_parameter =>
                                        let 'tt := function_parameter in
                                        __return (b, used_pkhes))))))
                  end)) (b, Signature.Public_key_hash.Set.empty) priorities)
        (fun _b => return_unit)).

Definition reward_retrieval {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 5)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
        (fun function_parameter =>
          let '{| parametric := {| preserved_cycles := preserved_cycles |} |} :=
            function_parameter in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar)
            (fun function_parameter =>
              let '(endorser, slots) := function_parameter in
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar
                  (Contract.implicit_contract endorser))
                (fun balance =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar endorser
                      op_startypeminuserrorstar tt)
                    (fun operation =>
                      let operation := Operation.pack operation in
                      let policy := op_startypeminuserrorstar in
                      op_gtgteqquestion (op_startypeminuserrorstar policy b)
                        (fun function_parameter =>
                          let '(_, priority, _) := function_parameter in
                          op_gtgteqquestion
                            (op_startypeminuserrorstar policy operation b)
                            (fun b =>
                              op_gtgteqquestion
                                (fold_left_s
                                  (fun b =>
                                    fun function_parameter =>
                                      let '_ := function_parameter in
                                      op_startypeminuserrorstar
                                        op_startypeminuserrorstar b) b
                                  (op_startypeminuserrorstar 0 preserved_cycles))
                                (fun b =>
                                  op_gtgteqquestion
                                    (get_expected_reward
                                      op_startypeminuserrorstar priority false
                                      (List.length slots))
                                    (fun reward =>
                                      op_startypeminuserrorstar __LOC__
                                        op_startypeminuserrorstar
                                        (Contract.implicit_contract endorser)
                                        balance reward))))))))).

Definition reward_retrieval_two_endorsers {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 5)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
        (fun function_parameter =>
          let '{|
            parametric := {|
              preserved_cycles := preserved_cycles;
                endorsement_security_deposit :=
                  endorsement_security_deposit;
                endorsement_reward := endorsement_reward
                |}
              |} := function_parameter in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar)
            (fun endorsers =>
              let endorser1 := List.hd endorsers in
              let endorser2 := List.hd (List.tl endorsers) in
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar
                  (Contract.implicit_contract (delegate endorser1)))
                (fun balance1 =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      (Contract.implicit_contract (delegate endorser2)))
                    (fun balance2 =>
                      op_gtgteqquestion
                        (Lwt.__return
                          (op_starquestion endorsement_security_deposit
                            (Int64.of_int (List.length (slots endorser1)))))
                        (fun security_deposit1 =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar (delegate endorser1)
                              op_startypeminuserrorstar tt)
                            (fun operation1 =>
                              let policy := op_startypeminuserrorstar in
                              op_gtgteqquestion
                                (op_startypeminuserrorstar policy b)
                                (fun function_parameter =>
                                  let '(_, priority, _) := function_parameter in
                                  op_startypeminuserrorstar
                                    (op_divquestion endorsement_reward
                                      (succ (of_int priority)))
                                    (fun reward_per_slot =>
                                      op_gtgteqquestion
                                        (Lwt.__return
                                          (op_starquestion reward_per_slot
                                            (Int64.of_int
                                              (List.length (slots endorser1)))))
                                        (fun reward1 =>
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar policy
                                              (Operation.pack operation1) b)
                                            (fun b =>
                                              op_gtgteqquestion
                                                (op_startypeminuserrorstar
                                                  __LOC__
                                                  op_startypeminuserrorstar
                                                  (Contract.implicit_contract
                                                    (delegate endorser1))
                                                  balance1 security_deposit1)
                                                (fun function_parameter =>
                                                  let 'tt := function_parameter
                                                    in
                                                  op_gtgteqquestion
                                                    (op_startypeminuserrorstar
                                                      __LOC__
                                                      op_startypeminuserrorstar
                                                      (Contract.implicit_contract
                                                        (delegate endorser2))
                                                      balance2)
                                                    (fun function_parameter =>
                                                      let 'tt :=
                                                        function_parameter in
                                                      op_gtgteqquestion
                                                        (op_startypeminuserrorstar
                                                          policy b)
                                                        (fun b =>
                                                          op_gtgteqquestion
                                                            (op_startypeminuserrorstar
                                                              __LOC__
                                                              op_startypeminuserrorstar
                                                              (Contract.implicit_contract
                                                                (delegate
                                                                  endorser1))
                                                              balance1
                                                              security_deposit1)
                                                            (fun
                                                              function_parameter
                                                              =>
                                                              let 'tt :=
                                                                function_parameter
                                                                in
                                                              op_gtgteqquestion
                                                                (op_startypeminuserrorstar
                                                                  __LOC__
                                                                  op_startypeminuserrorstar
                                                                  (Contract.implicit_contract
                                                                    (delegate
                                                                      endorser2))
                                                                  balance2)
                                                                (fun
                                                                  function_parameter
                                                                  =>
                                                                  let 'tt :=
                                                                    function_parameter
                                                                    in
                                                                  op_gtgteqquestion
                                                                    (op_startypeminuserrorstar
                                                                      op_startypeminuserrorstar)
                                                                    (fun
                                                                      endorsers
                                                                      =>
                                                                      let
                                                                        same_endorser2
                                                                        (endorser
                                                                        :
                                                                        Tezos_protocol_alpha.Protocol.Delegate_services.Endorsing_rights.t)
                                                                        : bool :=
                                                                        op_eq
                                                                          (Delegate_services.Endorsing_rights.delegate
                                                                            endorser)
                                                                          (delegate
                                                                            endorser2)
                                                                        in
                                                                      let
                                                                        endorser2 :=
                                                                        op_startypeminuserrorstar
                                                                          same_endorser2
                                                                          endorsers
                                                                        in
                                                                      op_gtgteqquestion
                                                                        (Lwt.__return
                                                                          (op_starquestion
                                                                            endorsement_security_deposit
                                                                            (Int64.of_int
                                                                              (List.length
                                                                                (slots
                                                                                  endorser2)))))
                                                                        (fun
                                                                          security_deposit2
                                                                          =>
                                                                          op_gtgteqquestion
                                                                            (op_startypeminuserrorstar
                                                                              (delegate
                                                                                endorser2)
                                                                              op_startypeminuserrorstar
                                                                              tt)
                                                                            (fun
                                                                              operation2
                                                                              =>
                                                                              op_gtgteqquestion
                                                                                (op_startypeminuserrorstar
                                                                                  policy
                                                                                  (Operation.pack
                                                                                    operation2)
                                                                                  b)
                                                                                (fun
                                                                                  b
                                                                                  =>
                                                                                  let
                                                                                    priority :=
                                                                                    priority
                                                                                      op_startypeminuserrorstar
                                                                                    in
                                                                                  op_startypeminuserrorstar
                                                                                    (op_divquestion
                                                                                      endorsement_reward
                                                                                      (succ
                                                                                        (of_int
                                                                                          priority)))
                                                                                    (fun
                                                                                      reward_per_slot
                                                                                      =>
                                                                                      op_gtgteqquestion
                                                                                        (Lwt.__return
                                                                                          (op_starquestion
                                                                                            reward_per_slot
                                                                                            (Int64.of_int
                                                                                              (List.length
                                                                                                (slots
                                                                                                  endorser2)))))
                                                                                        (fun
                                                                                          reward2
                                                                                          =>
                                                                                          op_gtgteqquestion
                                                                                            (op_startypeminuserrorstar
                                                                                              __LOC__
                                                                                              op_startypeminuserrorstar
                                                                                              (Contract.implicit_contract
                                                                                                (delegate
                                                                                                  endorser1))
                                                                                              balance1
                                                                                              security_deposit1)
                                                                                            (fun
                                                                                              function_parameter
                                                                                              =>
                                                                                              let
                                                                                                'tt :=
                                                                                                function_parameter
                                                                                                in
                                                                                              op_gtgteqquestion
                                                                                                (op_startypeminuserrorstar
                                                                                                  __LOC__
                                                                                                  op_startypeminuserrorstar
                                                                                                  (Contract.implicit_contract
                                                                                                    (delegate
                                                                                                      endorser2))
                                                                                                  balance2
                                                                                                  security_deposit2)
                                                                                                (fun
                                                                                                  function_parameter
                                                                                                  =>
                                                                                                  let
                                                                                                    'tt :=
                                                                                                    function_parameter
                                                                                                    in
                                                                                                  op_gtgteqquestion
                                                                                                    (fold_left_s
                                                                                                      (fun
                                                                                                        b
                                                                                                        =>
                                                                                                        fun
                                                                                                          function_parameter
                                                                                                          =>
                                                                                                          let
                                                                                                            '_ :=
                                                                                                            function_parameter
                                                                                                            in
                                                                                                          op_gtgteqquestion
                                                                                                            (op_startypeminuserrorstar
                                                                                                              __LOC__
                                                                                                              op_startypeminuserrorstar
                                                                                                              (Contract.implicit_contract
                                                                                                                (delegate
                                                                                                                  endorser1))
                                                                                                              balance1
                                                                                                              security_deposit1)
                                                                                                            (fun
                                                                                                              function_parameter
                                                                                                              =>
                                                                                                              let
                                                                                                                'tt :=
                                                                                                                function_parameter
                                                                                                                in
                                                                                                              op_gtgteqquestion
                                                                                                                (op_startypeminuserrorstar
                                                                                                                  __LOC__
                                                                                                                  op_startypeminuserrorstar
                                                                                                                  (Contract.implicit_contract
                                                                                                                    (delegate
                                                                                                                      endorser2))
                                                                                                                  balance2
                                                                                                                  security_deposit2)
                                                                                                                (fun
                                                                                                                  function_parameter
                                                                                                                  =>
                                                                                                                  let
                                                                                                                    'tt :=
                                                                                                                    function_parameter
                                                                                                                    in
                                                                                                                  op_startypeminuserrorstar
                                                                                                                    policy
                                                                                                                    b)))
                                                                                                      b
                                                                                                      (op_startypeminuserrorstar
                                                                                                        1
                                                                                                        preserved_cycles))
                                                                                                    (fun
                                                                                                      b
                                                                                                      =>
                                                                                                      op_gtgteqquestion
                                                                                                        (op_startypeminuserrorstar
                                                                                                          __LOC__
                                                                                                          op_startypeminuserrorstar
                                                                                                          (Contract.implicit_contract
                                                                                                            (delegate
                                                                                                              endorser1))
                                                                                                          balance1
                                                                                                          reward1)
                                                                                                        (fun
                                                                                                          function_parameter
                                                                                                          =>
                                                                                                          let
                                                                                                            'tt :=
                                                                                                            function_parameter
                                                                                                            in
                                                                                                          op_gtgteqquestion
                                                                                                            (op_startypeminuserrorstar
                                                                                                              __LOC__
                                                                                                              op_startypeminuserrorstar
                                                                                                              (Contract.implicit_contract
                                                                                                                (delegate
                                                                                                                  endorser2))
                                                                                                              balance2
                                                                                                              security_deposit2)
                                                                                                            (fun
                                                                                                              function_parameter
                                                                                                              =>
                                                                                                              let
                                                                                                                'tt :=
                                                                                                                function_parameter
                                                                                                                in
                                                                                                              op_gtgteqquestion
                                                                                                                (op_startypeminuserrorstar
                                                                                                                  policy
                                                                                                                  b)
                                                                                                                (fun
                                                                                                                  b
                                                                                                                  =>
                                                                                                                  op_gtgteqquestion
                                                                                                                    (op_startypeminuserrorstar
                                                                                                                      __LOC__
                                                                                                                      op_startypeminuserrorstar
                                                                                                                      (Contract.implicit_contract
                                                                                                                        (delegate
                                                                                                                          endorser1))
                                                                                                                      balance1
                                                                                                                      reward1)
                                                                                                                    (fun
                                                                                                                      function_parameter
                                                                                                                      =>
                                                                                                                      let
                                                                                                                        'tt :=
                                                                                                                        function_parameter
                                                                                                                        in
                                                                                                                      op_startypeminuserrorstar
                                                                                                                        __LOC__
                                                                                                                        op_startypeminuserrorstar
                                                                                                                        (Contract.implicit_contract
                                                                                                                          (delegate
                                                                                                                            endorser2))
                                                                                                                        balance2
                                                                                                                        reward2))))))))))))))))))))))))))))).

Definition wrong_endorsement_predecessor {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 5)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
        (fun function_parameter =>
          let '(genesis_endorser, _slots) := function_parameter in
          op_gtgteqquestion (op_startypeminuserrorstar b)
            (fun b' =>
              op_gtgteqquestion
                (op_startypeminuserrorstar genesis_endorser
                  op_startypeminuserrorstar op_startypeminuserrorstar tt)
                (fun operation =>
                  let operation := Operation.pack operation in
                  op_gtgteq (op_startypeminuserrorstar operation b')
                    (fun res =>
                      op_startypeminuserrorstar __LOC__ res
                        (fun function_parameter =>
                          match function_parameter with
                          |
                            Tezos_protocol_environment_alpha__Environment.Error_monad.Wrong_endorsement_predecessor
                              _ _ => true
                          | _ => false
                          end)))))).

Definition invalid_endorsement_level {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 5)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
        (fun genesis_level =>
          op_gtgteqquestion (op_startypeminuserrorstar b)
            (fun b =>
              op_gtgteqquestion
                (op_startypeminuserrorstar genesis_level
                  op_startypeminuserrorstar tt)
                (fun operation =>
                  let operation := Operation.pack operation in
                  op_gtgteq (op_startypeminuserrorstar operation b)
                    (fun res =>
                      op_startypeminuserrorstar __LOC__ res
                        (fun function_parameter =>
                          match function_parameter with
                          |
                            Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_endorsement_level
                            => true
                          | _ => false
                          end)))))).

Definition duplicate_endorsement {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 5)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun inc =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar tt)
            (fun operation =>
              let operation := Operation.pack operation in
              op_gtgteqquestion (op_startypeminuserrorstar inc operation)
                (fun inc =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar tt)
                    (fun operation =>
                      let operation := Operation.pack operation in
                      op_gtgteq (op_startypeminuserrorstar inc operation)
                        (fun res =>
                          op_startypeminuserrorstar __LOC__ res
                            (fun function_parameter =>
                              match function_parameter with
                              |
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Duplicate_endorsement
                                  _ => true
                              | _ => false
                              end))))))).

Definition not_enough_for_deposit {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 5 1)
    (fun function_parameter =>
      let '(b_init, contracts) := function_parameter in
      op_gtgteqquestion
        (Error_monad.map_s
          (fun c =>
            op_gtgteqquestion
              (op_startypeminuserrorstar op_startypeminuserrorstar c)
              (fun m => __return (m, c))) contracts)
        (fun managers =>
          op_gtgteqquestion (op_startypeminuserrorstar b_init)
            (fun b =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar)
                (fun function_parameter =>
                  let '(endorser, _slots) := function_parameter in
                  let '(_, contract_other_than_endorser) :=
                    op_startypeminuserrorstar
                      (fun function_parameter =>
                        let '(c, _) := function_parameter in
                        not
                          (Signature.Public_key_hash.equal (Account.pkh c)
                            endorser)) managers in
                  let '(_, contract_of_endorser) :=
                    op_startypeminuserrorstar
                      (fun function_parameter =>
                        let '(c, _) := function_parameter in
                        Signature.Public_key_hash.equal (Account.pkh c) endorser)
                      managers in
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      (Contract.implicit_contract endorser))
                    (fun initial_balance =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          contract_of_endorser contract_other_than_endorser
                          initial_balance)
                        (fun op_trans =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar op_trans b_init)
                            (fun b =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar endorser
                                  op_startypeminuserrorstar tt)
                                (fun op_endo =>
                                  op_gtgteq
                                    (op_startypeminuserrorstar
                                      op_startypeminuserrorstar
                                      (Operation.pack op_endo) b)
                                    (fun res =>
                                      op_startypeminuserrorstar __LOC__ res
                                        (fun function_parameter =>
                                          match function_parameter with
                                          |
                                            Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low_for_deposit
                                              _ => true
                                          | _ => false
                                          end)))))))))).

Definition endorsement_threshold (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  let initial_endorsers := 28 in
  let num_accounts := 100 in
  op_gtgteqquestion (op_startypeminuserrorstar initial_endorsers num_accounts)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
        (fun endorsers =>
          let num_endorsers := List.length endorsers in
          op_gtgteqquestion
            (iter_s
              (fun i =>
                let priority := op_minus num_endorsers i in
                let crt_endorsers := op_startypeminuserrorstar i endorsers in
                let endorsing_power := endorsing_power crt_endorsers in
                let delegates := delegates_with_slots crt_endorsers in
                op_gtgteqquestion
                  (map_s
                    (fun x =>
                      op_startypeminuserrorstar x op_startypeminuserrorstar tt)
                    delegates)
                  (fun ops =>
                    op_gtgteqquestion
                      (op_startypeminuserrorstar op_startypeminuserrorstar
                        priority endorsing_power)
                      (fun timestamp =>
                        let seconds :=
                          sub
                            (of_string (Timestamp.to_seconds_string timestamp))
                            (* ❌ Constant of type int64 is converted to int *)
                            1 in
                        match Timestamp.of_seconds (Int64.to_string seconds)
                          with
                        | None =>
                          failwith
                            "timestamp to/from string manipulation failed" %
                              string
                        | Some timestamp =>
                          op_gtgteq
                            (op_startypeminuserrorstar timestamp
                              op_startypeminuserrorstar
                              (List.map Operation.pack ops) b)
                            (fun b2 =>
                              op_startypeminuserrorstar __LOC__ b2
                                (fun function_parameter =>
                                  match function_parameter with
                                  |
                                    Tezos_protocol_environment_alpha__Environment.Error_monad.Timestamp_too_early
                                      _ _ |
                                      Tezos_protocol_environment_alpha__Environment.Error_monad.Not_enough_endorsements_for_priority
                                        _ => true
                                  | _ => false
                                  end))
                        end)))
              (op_startypeminuserrorstar 0 (op_minus num_endorsers 1)))
            (fun function_parameter =>
              let 'tt := function_parameter in
              let priority := 0 in
              let endorsing_power := endorsing_power endorsers in
              let delegates := delegates_with_slots endorsers in
              op_gtgteqquestion
                (map_s
                  (fun delegate =>
                    op_startypeminuserrorstar delegate op_startypeminuserrorstar
                      tt) delegates)
                (fun ops =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      priority endorsing_power)
                    (fun timestamp =>
                      op_gtgteq
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          timestamp (List.map Operation.pack ops) b)
                        (fun function_parameter =>
                          let '_ := function_parameter in
                          return_unit)))))).

Definition test_fitness_gap (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  let num_accounts := 5 in
  op_gtgteqquestion (op_startypeminuserrorstar num_accounts)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion
        match Fitness_repr.to_int64 (fitness (shell (header b))) with
        | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok fitness =>
          __return (Int64.to_int fitness)
        | Tezos_protocol_environment_alpha__Environment.Pervasives.Error _ =>
          (* ❌ Assert instruction is not handled. *)
          assert false
        end
        (fun fitness =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar)
            (fun function_parameter =>
              let '(delegate, _slots) := function_parameter in
              op_gtgteqquestion
                (op_startypeminuserrorstar delegate op_startypeminuserrorstar tt)
                (fun op =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      (cons (Operation.pack op) []) b)
                    (fun b =>
                      op_gtgteqquestion
                        match Fitness_repr.to_int64 (fitness (shell (header b)))
                          with
                        |
                          Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                            new_fitness =>
                          __return (op_minus (Int64.to_int new_fitness) fitness)
                        |
                          Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                            _ =>
                          (* ❌ Assert instruction is not handled. *)
                          assert false
                        end
                        (fun res =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar __LOC__ res 1)
                            (fun function_parameter =>
                              let 'tt := function_parameter in
                              return_unit))))))).

Definition tests {A : Type} : list A :=
  cons
    (op_startypeminuserrorstar "Simple endorsement" % string
      (* ❌ Variants not supported *)
      variant simple_endorsement)
    (cons
      (op_startypeminuserrorstar "Maximum endorsement" % string
        (* ❌ Variants not supported *)
        variant max_endorsement)
      (cons
        (op_startypeminuserrorstar "Consistent priorities" % string
          (* ❌ Variants not supported *)
          variant consistent_priorities)
        (cons
          (op_startypeminuserrorstar "Reward retrieval" % string
            (* ❌ Variants not supported *)
            variant reward_retrieval)
          (cons
            (op_startypeminuserrorstar "Reward retrieval two endorsers" % string
              (* ❌ Variants not supported *)
              variant reward_retrieval_two_endorsers)
            (cons
              (op_startypeminuserrorstar "Endorsement threshold" % string
                (* ❌ Variants not supported *)
                variant endorsement_threshold)
              (cons
                (op_startypeminuserrorstar "Fitness gap" % string
                  (* ❌ Variants not supported *)
                  variant test_fitness_gap)
                (cons
                  (op_startypeminuserrorstar
                    "Wrong endorsement predecessor" % string
                    (* ❌ Variants not supported *)
                    variant wrong_endorsement_predecessor)
                  (cons
                    (op_startypeminuserrorstar
                      "Invalid endorsement level" % string
                      (* ❌ Variants not supported *)
                      variant invalid_endorsement_level)
                    (cons
                      (op_startypeminuserrorstar
                        "Duplicate endorsement" % string
                        (* ❌ Variants not supported *)
                        variant duplicate_endorsement)
                      (cons
                        (op_startypeminuserrorstar
                          "Not enough for deposit" % string
                          (* ❌ Variants not supported *)
                          variant not_enough_for_deposit) [])))))))))).
test/helpers/account.ml 6 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol

type t = {
  pkh : Signature.Public_key_hash.t;
  pk : Signature.Public_key.t;
  sk : Signature.Secret_key.t;
}

type account = t

let known_accounts = Signature.Public_key_hash.Table.create 17

let new_account ?seed () =
  let seed = Option.map ~f:Bigstring.of_bytes seed in
  let (pkh, pk, sk) = Signature.generate_key ?seed () in
  let account = {pkh; pk; sk} in
  Signature.Public_key_hash.Table.add known_accounts pkh account ;
  account

let add_account ({pkh; _} as account) =
  Signature.Public_key_hash.Table.add known_accounts pkh account

let activator_account = new_account ()

let find pkh =
  try return (Signature.Public_key_hash.Table.find known_accounts pkh)
  with Not_found ->
    failwith "Missing account: %a" Signature.Public_key_hash.pp pkh

let find_alternate pkh =
  let exception Found of t in
  try
    Signature.Public_key_hash.Table.iter
      (fun pkh' account ->
        if not (Signature.Public_key_hash.equal pkh pkh') then
          raise (Found account))
      known_accounts ;
    raise Not_found
  with Found account -> account

let dummy_account = new_account ()

let generate_accounts ?(initial_balances = []) n : (t * Tez_repr.t) list =
  Signature.Public_key_hash.Table.clear known_accounts ;
  let default_amount = Tez_repr.of_mutez_exn 4_000_000_000_000L in
  let amount i =
    match List.nth_opt initial_balances i with
    | None ->
        default_amount
    | Some a ->
        Tez_repr.of_mutez_exn a
  in
  List.map
    (fun i ->
      let (pkh, pk, sk) = Signature.generate_key () in
      let account = {pkh; pk; sk} in
      Signature.Public_key_hash.Table.add known_accounts pkh account ;
      (account, amount i))
    (0 -- (n - 1))

let commitment_secret =
  Blinded_public_key_hash.activation_code_of_hex
    "aaaaaaaaaaaaaaaaaaaabbbbbbbbbbbbbbbbbbbb"

let new_commitment ?seed () =
  let seed = Option.map ~f:Bigstring.of_bytes seed in
  let (pkh, pk, sk) = Signature.generate_key ?seed ~algo:Ed25519 () in
  let unactivated_account = {pkh; pk; sk} in
  let open Commitment_repr in
  let pkh = match pkh with Ed25519 pkh -> pkh | _ -> assert false in
  let bpkh = Blinded_public_key_hash.of_ed25519_pkh commitment_secret pkh in
  (Lwt.return @@ Environment.wrap_error @@ Tez_repr.(one *? 4_000L))
  >>=? fun amount ->
  return @@ (unactivated_account, {blinded_public_key_hash = bpkh; amount})
account_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Protocol.

Record t := {
  pkh : Tezos_base__TzPervasives.Signature.Public_key_hash.t;
  pk : Tezos_base__TzPervasives.Signature.Public_key.t;
  sk : Tezos_base__TzPervasives.Signature.Secret_key.t }.

Definition account := t.

Definition known_accounts
  : Tezos_base__TzPervasives.Signature.Public_key_hash.Table.t t :=
  Signature.Public_key_hash.Table.create 17.

Definition new_account
  (seed : option Stdlib.Bytes.t) (function_parameter : unit) : t :=
  let 'tt := function_parameter in
  let seed := Option.map Bigstring.of_bytes seed in
  let '(pkh, pk, sk) := Signature.generate_key None seed tt in
  let account := {| pkh := pkh; pk := pk; sk := sk |} in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ := Signature.Public_key_hash.Table.add known_accounts pkh account in
  account.

Definition add_account (function_parameter : t) : unit :=
  let '{| pkh := pkh |} as account := function_parameter in
  Signature.Public_key_hash.Table.add known_accounts pkh account.

Definition activator_account : t := new_account None tt.

Definition find
  (pkh : Tezos_base__TzPervasives.Signature.Public_key_hash.Table.key)
  : Lwt.t (Tezos_base__TzPervasives.tzresult t) :=
  (* ❌ Try-with are not handled *)
  try (__return (Signature.Public_key_hash.Table.find known_accounts pkh)).

Definition find_alternate
  (pkh : Tezos_base__TzPervasives.Signature.Public_key_hash.t) : t :=
  (* ❌ Let of exception is not handled *)
  let_exception.

Definition dummy_account : t := new_account None tt.

Definition generate_accounts (op_staroptstar : option (list int64))
  : Z -> list (t * Tezos_protocol_alpha.Protocol.Tez_repr.t) :=
  let initial_balances :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => []
    end in
  fun n =>
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ := Signature.Public_key_hash.Table.clear known_accounts in
    let default_amount :=
      Tez_repr.of_mutez_exn
        (* ❌ Constant of type int64 is converted to int *)
        4000000000000 in
    let amount (i : Z) : Tezos_protocol_alpha.Protocol.Tez_repr.t :=
      match List.nth_opt initial_balances i with
      | None => default_amount
      | Some a => Tez_repr.of_mutez_exn a
      end in
    List.map
      (fun i =>
        let '(pkh, pk, sk) := Signature.generate_key None None tt in
        let account := {| pkh := pkh; pk := pk; sk := sk |} in
        (* ❌ Sequences of instructions are not handled (operator ";") *)
        let _ := Signature.Public_key_hash.Table.add known_accounts pkh account
          in
        (account, (amount i))) (op_minusminus 0 (Z.sub n 1)).

Definition commitment_secret
  : Tezos_protocol_alpha.Protocol.Blinded_public_key_hash.activation_code :=
  Blinded_public_key_hash.activation_code_of_hex
    "aaaaaaaaaaaaaaaaaaaabbbbbbbbbbbbbbbbbbbb" % string.

Definition new_commitment
  (seed : option Stdlib.Bytes.t) (function_parameter : unit)
  : Lwt.t
    (Tezos_base__TzPervasives.tzresult
      (t * Tezos_protocol_alpha.Protocol.Commitment_repr.t)) :=
  let 'tt := function_parameter in
  let seed := Option.map Bigstring.of_bytes seed in
  let '(pkh, pk, sk) :=
    Signature.generate_key (Some Tezos_base__TzPervasives.Signature.Ed25519)
      seed tt in
  let unactivated_account := {| pkh := pkh; pk := pk; sk := sk |} in
  let pkh :=
    match pkh with
    | Tezos_base__TzPervasives.Signature.Ed25519 pkh => pkh
    | _ =>
      (* ❌ Assert instruction is not handled. *)
      assert false
    end in
  let bpkh := Blinded_public_key_hash.of_ed25519_pkh commitment_secret pkh in
  op_gtgteqquestion
    (apply Lwt.__return
      (apply Environment.wrap_error
        (op_starquestion one
          (* ❌ Constant of type int64 is converted to int *)
          4000)))
    (fun amount =>
      apply __return
        (unactivated_account,
          {| blinded_public_key_hash := bpkh; amount := amount |})).
test/helpers/account.mli success 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol

type t = {
  pkh : Signature.Public_key_hash.t;
  pk : Signature.Public_key.t;
  sk : Signature.Secret_key.t;
}

type account = t

val known_accounts : t Signature.Public_key_hash.Table.t

val activator_account : account

val dummy_account : account

val new_account : ?seed:MBytes.t -> unit -> account

val add_account : t -> unit

val find : Signature.Public_key_hash.t -> t tzresult Lwt.t

val find_alternate : Signature.Public_key_hash.t -> t

(** [generate_accounts ?initial_balances n] : generates [n] random
    accounts with the initial balance of the [i]th account given by the
    [i]th value in the list [initial_balances] or otherwise
    4.000.000.000 tz (if the list is too short); and add them to the
    global account state *)
val generate_accounts :
  ?initial_balances:int64 list -> int -> (t * Tez_repr.t) list

val commitment_secret : Blinded_public_key_hash.activation_code

val new_commitment :
  ?seed:MBytes.t -> unit -> (account * Commitment_repr.t) tzresult Lwt.t
account_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Record t := {
  pkh : Tezos_base__TzPervasives.Signature.Public_key_hash.t;
  pk : Tezos_base__TzPervasives.Signature.Public_key.t;
  sk : Tezos_base__TzPervasives.Signature.Secret_key.t }.

Definition account := t.

Parameter known_accounts :
Tezos_base__TzPervasives.Signature.Public_key_hash.Table.t t.

Parameter activator_account : account.

Parameter dummy_account : account.

Parameter new_account :
option Tezos_base__TzPervasives.MBytes.t -> unit -> account.

Parameter add_account : t -> unit.

Parameter find :
Tezos_base__TzPervasives.Signature.Public_key_hash.t ->
  Lwt.t (Tezos_base__TzPervasives.tzresult t).

Parameter find_alternate :
Tezos_base__TzPervasives.Signature.Public_key_hash.t -> t.

Parameter generate_accounts :
option (list int64) -> Z -> list (t * Tezos_protocol_alpha.Protocol.Tez_repr.t).

Parameter commitment_secret :
Tezos_protocol_alpha.Protocol.Blinded_public_key_hash.activation_code.

Parameter new_commitment :
option Tezos_base__TzPervasives.MBytes.t ->
  unit ->
    Lwt.t
      (Tezos_base__TzPervasives.tzresult
        (account * Tezos_protocol_alpha.Protocol.Commitment_repr.t)).
test/helpers/assert.ml 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol

let error ~loc v f =
  match v with
  | Error err when List.exists f err ->
      return_unit
  | Ok _ ->
      failwith "Unexpected successful result (%s)" loc
  | Error err ->
      failwith "@[Unexpected error (%s): %a@]" loc pp_print_error err

let proto_error ~loc v f =
  error ~loc v (function
      | Environment.Ecoproto_error err ->
          f err
      | _ ->
          false)

let equal ~loc (cmp : 'a -> 'a -> bool) msg pp a b =
  if not (cmp a b) then
    failwith "@[@[[%s]@] - @[%s : %a is not equal to %a@]@]" loc msg pp a pp b
  else return_unit

let not_equal ~loc (cmp : 'a -> 'a -> bool) msg pp a b =
  if cmp a b then
    failwith "@[@[[%s]@] - @[%s : %a is equal to %a@]@]" loc msg pp a pp b
  else return_unit

(* tez *)
let equal_tez ~loc (a : Alpha_context.Tez.t) (b : Alpha_context.Tez.t) =
  let open Alpha_context in
  equal ~loc Tez.( = ) "Tez aren't equal" Tez.pp a b

let not_equal_tez ~loc (a : Alpha_context.Tez.t) (b : Alpha_context.Tez.t) =
  let open Alpha_context in
  not_equal ~loc Tez.( = ) "Tez are equal" Tez.pp a b

(* int *)
let equal_int ~loc (a : int) (b : int) =
  equal ~loc ( = ) "Integers aren't equal" Format.pp_print_int a b

let not_equal_int ~loc (a : int) (b : int) =
  not_equal ~loc ( = ) "Integers are equal" Format.pp_print_int a b

(* bool *)
let equal_bool ~loc (a : bool) (b : bool) =
  equal ~loc ( = ) "Booleans aren't equal" Format.pp_print_bool a b

let not_equal_bool ~loc (a : bool) (b : bool) =
  not_equal ~loc ( = ) "Booleans are equal" Format.pp_print_bool a b

(* pkh *)
let equal_pkh ~loc (a : Signature.Public_key_hash.t)
    (b : Signature.Public_key_hash.t) =
  let module PKH = Signature.Public_key_hash in
  equal ~loc PKH.equal "Public key hashes  aren't equal" PKH.pp a b

let not_equal_pkh ~loc (a : Signature.Public_key_hash.t)
    (b : Signature.Public_key_hash.t) =
  let module PKH = Signature.Public_key_hash in
  not_equal ~loc PKH.equal "Public key hashes are equal" PKH.pp a b

open Context

(* Some asserts for account operations *)

(** [balance_is b c amount] checks that the current balance of contract [c] is
    [amount].
    Default balance type is [Main], pass [~kind] with [Deposit], [Fees] or
    [Rewards] for the others. *)
let balance_is ~loc b contract ?(kind = Contract.Main) expected =
  Contract.balance b contract ~kind
  >>=? fun balance -> equal_tez ~loc balance expected

(** [balance_was_operated ~operand b c old_balance amount] checks that the
    current balance of contract [c] is [operand old_balance amount] and
    returns the current balance.
    Default balance type is [Main], pass [~kind] with [Deposit], [Fees] or
    [Rewards] for the others. *)
let balance_was_operated ~operand ~loc b contract ?(kind = Contract.Main)
    old_balance amount =
  operand old_balance amount |> Environment.wrap_error |> Lwt.return
  >>=? fun expected -> balance_is ~loc b contract ~kind expected

let balance_was_credited =
  balance_was_operated ~operand:Alpha_context.Tez.( +? )

let balance_was_debited =
  balance_was_operated ~operand:Alpha_context.Tez.( -? )

(* debug *)

let print_balances ctxt id =
  Contract.balance ~kind:Main ctxt id
  >>=? fun main ->
  Contract.balance ~kind:Deposit ctxt id
  >>=? fun deposit ->
  Contract.balance ~kind:Fees ctxt id
  >>=? fun fees ->
  Contract.balance ~kind:Rewards ctxt id
  >>|? fun rewards ->
  Format.printf
    "\nMain: %s\nDeposit: %s\nFees: %s\nRewards: %s\n"
    (Alpha_context.Tez.to_string main)
    (Alpha_context.Tez.to_string deposit)
    (Alpha_context.Tez.to_string fees)
    (Alpha_context.Tez.to_string rewards)
assert_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Protocol.

Definition error {A : Type}
  (loc : string) (v : sum A Tezos_base__TzPervasives.trace)
  (f : Tezos_base__TzPervasives.error -> bool)
  : Lwt.t (Tezos_base__TzPervasives.tzresult unit) :=
  match v with
  | Stdlib.Error err => return_unit
  | Stdlib.Ok _ =>
    failwith
      (CamlinternalFormatBasics.Format
        (CamlinternalFormatBasics.String_literal
          "Unexpected successful result (" % string
          (CamlinternalFormatBasics.String CamlinternalFormatBasics.No_padding
            (CamlinternalFormatBasics.Char_literal ")" % char
              CamlinternalFormatBasics.End_of_format)))
        "Unexpected successful result (%s)" % string) loc
  | Stdlib.Error err =>
    failwith
      (CamlinternalFormatBasics.Format
        (CamlinternalFormatBasics.Formatting_gen
          (CamlinternalFormatBasics.Open_box
            (CamlinternalFormatBasics.Format
              CamlinternalFormatBasics.End_of_format "" % string))
          (CamlinternalFormatBasics.String_literal "Unexpected error (" % string
            (CamlinternalFormatBasics.String CamlinternalFormatBasics.No_padding
              (CamlinternalFormatBasics.String_literal "): " % string
                (CamlinternalFormatBasics.Alpha
                  (CamlinternalFormatBasics.Formatting_lit
                    CamlinternalFormatBasics.Close_box
                    CamlinternalFormatBasics.End_of_format))))))
        "@[Unexpected error (%s): %a@]" % string) loc pp_print_error err
  end.

Definition proto_error {A : Type}
  (loc : string) (v : sum A Tezos_base__TzPervasives.trace)
  (f : Tezos_protocol_alpha.Protocol.Environment.Error_monad.error -> bool)
  : Lwt.t (Tezos_base__TzPervasives.tzresult unit) :=
  error loc v
    (fun function_parameter =>
      match function_parameter with
      | Tezos_base__TzPervasives.Error_monad.Ecoproto_error err => f err
      | _ => false
      end).

Definition equal {a : Type}
  (loc : string) (cmp : a -> a -> bool) (msg : string)
  (pp : Stdlib.Format.formatter -> a -> unit) (a : a) (b : a)
  : Lwt.t (Tezos_base__TzPervasives.tzresult unit) :=
  if negb (cmp a b) then
    failwith
      (CamlinternalFormatBasics.Format
        (CamlinternalFormatBasics.Formatting_gen
          (CamlinternalFormatBasics.Open_box
            (CamlinternalFormatBasics.Format
              CamlinternalFormatBasics.End_of_format "" % string))
          (CamlinternalFormatBasics.Formatting_gen
            (CamlinternalFormatBasics.Open_box
              (CamlinternalFormatBasics.Format
                CamlinternalFormatBasics.End_of_format "" % string))
            (CamlinternalFormatBasics.Char_literal "[" % char
              (CamlinternalFormatBasics.String
                CamlinternalFormatBasics.No_padding
                (CamlinternalFormatBasics.Char_literal "]" % char
                  (CamlinternalFormatBasics.Formatting_lit
                    CamlinternalFormatBasics.Close_box
                    (CamlinternalFormatBasics.String_literal " - " % string
                      (CamlinternalFormatBasics.Formatting_gen
                        (CamlinternalFormatBasics.Open_box
                          (CamlinternalFormatBasics.Format
                            CamlinternalFormatBasics.End_of_format "" % string))
                        (CamlinternalFormatBasics.String
                          CamlinternalFormatBasics.No_padding
                          (CamlinternalFormatBasics.String_literal
                            " : " % string
                            (CamlinternalFormatBasics.Alpha
                              (CamlinternalFormatBasics.String_literal
                                " is not equal to " % string
                                (CamlinternalFormatBasics.Alpha
                                  (CamlinternalFormatBasics.Formatting_lit
                                    CamlinternalFormatBasics.Close_box
                                    (CamlinternalFormatBasics.Formatting_lit
                                      CamlinternalFormatBasics.Close_box
                                      CamlinternalFormatBasics.End_of_format)))))))))))))))
        "@[@[[%s]@] - @[%s : %a is not equal to %a@]@]" % string) loc msg pp a
      pp b
  else
    return_unit.

Definition not_equal {a : Type}
  (loc : string) (cmp : a -> a -> bool) (msg : string)
  (pp : Stdlib.Format.formatter -> a -> unit) (a : a) (b : a)
  : Lwt.t (Tezos_base__TzPervasives.tzresult unit) :=
  if cmp a b then
    failwith
      (CamlinternalFormatBasics.Format
        (CamlinternalFormatBasics.Formatting_gen
          (CamlinternalFormatBasics.Open_box
            (CamlinternalFormatBasics.Format
              CamlinternalFormatBasics.End_of_format "" % string))
          (CamlinternalFormatBasics.Formatting_gen
            (CamlinternalFormatBasics.Open_box
              (CamlinternalFormatBasics.Format
                CamlinternalFormatBasics.End_of_format "" % string))
            (CamlinternalFormatBasics.Char_literal "[" % char
              (CamlinternalFormatBasics.String
                CamlinternalFormatBasics.No_padding
                (CamlinternalFormatBasics.Char_literal "]" % char
                  (CamlinternalFormatBasics.Formatting_lit
                    CamlinternalFormatBasics.Close_box
                    (CamlinternalFormatBasics.String_literal " - " % string
                      (CamlinternalFormatBasics.Formatting_gen
                        (CamlinternalFormatBasics.Open_box
                          (CamlinternalFormatBasics.Format
                            CamlinternalFormatBasics.End_of_format "" % string))
                        (CamlinternalFormatBasics.String
                          CamlinternalFormatBasics.No_padding
                          (CamlinternalFormatBasics.String_literal
                            " : " % string
                            (CamlinternalFormatBasics.Alpha
                              (CamlinternalFormatBasics.String_literal
                                " is equal to " % string
                                (CamlinternalFormatBasics.Alpha
                                  (CamlinternalFormatBasics.Formatting_lit
                                    CamlinternalFormatBasics.Close_box
                                    (CamlinternalFormatBasics.Formatting_lit
                                      CamlinternalFormatBasics.Close_box
                                      CamlinternalFormatBasics.End_of_format)))))))))))))))
        "@[@[[%s]@] - @[%s : %a is equal to %a@]@]" % string) loc msg pp a pp b
  else
    return_unit.

Definition equal_tez
  (loc : string) (a : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.t)
  (b : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.t)
  : Lwt.t (Tezos_base__TzPervasives.tzresult unit) :=
  equal loc Tez.op_eq "Tez aren't equal" % string Tez.pp a b.

Definition not_equal_tez
  (loc : string) (a : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.t)
  (b : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.t)
  : Lwt.t (Tezos_base__TzPervasives.tzresult unit) :=
  not_equal loc Tez.op_eq "Tez are equal" % string Tez.pp a b.

Definition equal_int (loc : string) (a : Z) (b : Z)
  : Lwt.t (Tezos_base__TzPervasives.tzresult unit) :=
  equal loc equiv_decb "Integers aren't equal" % string Format.pp_print_int a b.

Definition not_equal_int (loc : string) (a : Z) (b : Z)
  : Lwt.t (Tezos_base__TzPervasives.tzresult unit) :=
  not_equal loc equiv_decb "Integers are equal" % string Format.pp_print_int a b.

Definition equal_bool (loc : string) (a : bool) (b : bool)
  : Lwt.t (Tezos_base__TzPervasives.tzresult unit) :=
  equal loc equiv_decb "Booleans aren't equal" % string Format.pp_print_bool a b.

Definition not_equal_bool (loc : string) (a : bool) (b : bool)
  : Lwt.t (Tezos_base__TzPervasives.tzresult unit) :=
  not_equal loc equiv_decb "Booleans are equal" % string Format.pp_print_bool a
    b.

Definition equal_pkh
  (loc : string) (a : Tezos_base__TzPervasives.Signature.Public_key_hash.t)
  (b : Tezos_base__TzPervasives.Signature.Public_key_hash.t)
  : Lwt.t (Tezos_base__TzPervasives.tzresult unit) :=
  let PKH := Signature.Public_key_hash in
  equal loc PKH.equal "Public key hashes  aren't equal" % string PKH.pp a b.

Definition not_equal_pkh
  (loc : string) (a : Tezos_base__TzPervasives.Signature.Public_key_hash.t)
  (b : Tezos_base__TzPervasives.Signature.Public_key_hash.t)
  : Lwt.t (Tezos_base__TzPervasives.tzresult unit) :=
  let PKH := Signature.Public_key_hash in
  not_equal loc PKH.equal "Public key hashes are equal" % string PKH.pp a b.

Import Context.

Definition balance_is
  (loc : string) (b : Tezos_alpha_test_helpers__Context.t)
  (contract : Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t)
  (op_staroptstar :
    option Tezos_alpha_test_helpers.Context.Contract.balance_kind)
  : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.t ->
    Lwt.t (Tezos_base__TzPervasives.tzresult unit) :=
  let kind :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => Tezos_alpha_test_helpers.Context.Contract.Main
    end in
  fun expected =>
    op_gtgteqquestion (Contract.balance (Some kind) b contract)
      (fun balance => equal_tez loc balance expected).

Definition balance_was_operated {A B : Type}
  (operand :
    A ->
      B ->
        Tezos_protocol_alpha.Protocol.Environment.Error_monad.tzresult
          Tezos_protocol_alpha.Protocol.Alpha_context.Tez.t) (loc : string)
  (b : Tezos_alpha_test_helpers__Context.t)
  (contract : Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t)
  (op_staroptstar :
    option Tezos_alpha_test_helpers.Context.Contract.balance_kind)
  : A -> B -> Lwt.t (Tezos_base__TzPervasives.tzresult unit) :=
  let kind :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => Tezos_alpha_test_helpers.Context.Contract.Main
    end in
  fun old_balance =>
    fun amount =>
      op_gtgteqquestion
        (OCaml.Stdlib.reverse_apply
          (OCaml.Stdlib.reverse_apply (operand old_balance amount)
            Environment.wrap_error) Lwt.__return)
        (fun expected => balance_is loc b contract (Some kind) expected).

Definition balance_was_credited
  : string ->
    Tezos_alpha_test_helpers__Context.t ->
      Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t ->
        option Tezos_alpha_test_helpers.Context.Contract.balance_kind ->
          Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez ->
            Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez ->
              Lwt.t (Tezos_base__TzPervasives.tzresult unit) :=
  balance_was_operated Alpha_context.Tez.op_plusquestion.

Definition balance_was_debited
  : string ->
    Tezos_alpha_test_helpers__Context.t ->
      Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t ->
        option Tezos_alpha_test_helpers.Context.Contract.balance_kind ->
          Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez ->
            Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez ->
              Lwt.t (Tezos_base__TzPervasives.tzresult unit) :=
  balance_was_operated Alpha_context.Tez.op_minusquestion.

Definition print_balances
  (ctxt : Tezos_alpha_test_helpers__Context.t)
  (id : Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t)
  : Lwt.t (Tezos_base__TzPervasives.tzresult unit) :=
  op_gtgteqquestion
    (Contract.balance (Some Tezos_alpha_test_helpers.Context.Contract.Main) ctxt
      id)
    (fun main =>
      op_gtgteqquestion
        (Contract.balance
          (Some Tezos_alpha_test_helpers.Context.Contract.Deposit) ctxt id)
        (fun deposit =>
          op_gtgteqquestion
            (Contract.balance
              (Some Tezos_alpha_test_helpers.Context.Contract.Fees) ctxt id)
            (fun fees =>
              op_gtgtpipequestion
                (Contract.balance
                  (Some Tezos_alpha_test_helpers.Context.Contract.Rewards) ctxt
                  id)
                (fun rewards =>
                  Format.printf
                    (CamlinternalFormatBasics.Format
                      (CamlinternalFormatBasics.String_literal
                        "
Main: " % string
                        (CamlinternalFormatBasics.String
                          CamlinternalFormatBasics.No_padding
                          (CamlinternalFormatBasics.String_literal
                            "
Deposit: " % string
                            (CamlinternalFormatBasics.String
                              CamlinternalFormatBasics.No_padding
                              (CamlinternalFormatBasics.String_literal
                                "
Fees: " % string
                                (CamlinternalFormatBasics.String
                                  CamlinternalFormatBasics.No_padding
                                  (CamlinternalFormatBasics.String_literal
                                    "
Rewards: " % string
                                    (CamlinternalFormatBasics.String
                                      CamlinternalFormatBasics.No_padding
                                      (CamlinternalFormatBasics.Char_literal
                                        "010" % char
                                        CamlinternalFormatBasics.End_of_format)))))))))
                      "
Main: %s
Deposit: %s
Fees: %s
Rewards: %s
" % string)
                    (Alpha_context.Tez.to_string main)
                    (Alpha_context.Tez.to_string deposit)
                    (Alpha_context.Tez.to_string fees)
                    (Alpha_context.Tez.to_string rewards))))).
test/helpers/block.ml 7 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol
module Proto_Nonce = Nonce (* Renamed otherwise is masked by Alpha_context *)

open Alpha_context

(* This type collects a block and the context that results from its application *)
type t = {
  hash : Block_hash.t;
  header : Block_header.t;
  operations : Operation.packed list;
  context : Tezos_protocol_environment.Context.t;
}

type block = t

let rpc_context block =
  {
    Environment.Updater.block_hash = block.hash;
    block_header = block.header.shell;
    context = block.context;
  }

let rpc_ctxt =
  new Environment.proto_rpc_context_of_directory rpc_context rpc_services

(******** Policies ***********)

(* Policies are functions that take a block and return a tuple
   [(account, level, timestamp)] for the [forge_header] function. *)

(* This type is used only to provide a simpler interface to the exterior. *)
type baker_policy =
  | By_priority of int
  | By_account of public_key_hash
  | Excluding of public_key_hash list

let get_next_baker_by_priority priority block =
  Alpha_services.Delegate.Baking_rights.get
    rpc_ctxt
    ~all:true
    ~max_priority:(priority + 1)
    block
  >>=? fun bakers ->
  let {Alpha_services.Delegate.Baking_rights.delegate = pkh; timestamp; _} =
    List.find
      (fun {Alpha_services.Delegate.Baking_rights.priority = p; _} ->
        p = priority)
      bakers
  in
  return (pkh, priority, Option.unopt_exn (Failure "") timestamp)

let get_next_baker_by_account pkh block =
  Alpha_services.Delegate.Baking_rights.get
    rpc_ctxt
    ~delegates:[pkh]
    ~max_priority:256
    block
  >>=? fun bakers ->
  let { Alpha_services.Delegate.Baking_rights.delegate = pkh;
        timestamp;
        priority;
        _ } =
    List.hd bakers
  in
  return (pkh, priority, Option.unopt_exn (Failure "") timestamp)

let get_next_baker_excluding excludes block =
  Alpha_services.Delegate.Baking_rights.get rpc_ctxt ~max_priority:256 block
  >>=? fun bakers ->
  let { Alpha_services.Delegate.Baking_rights.delegate = pkh;
        timestamp;
        priority;
        _ } =
    List.find
      (fun {Alpha_services.Delegate.Baking_rights.delegate; _} ->
        not (List.mem delegate excludes))
      bakers
  in
  return (pkh, priority, Option.unopt_exn (Failure "") timestamp)

let dispatch_policy = function
  | By_priority p ->
      get_next_baker_by_priority p
  | By_account a ->
      get_next_baker_by_account a
  | Excluding al ->
      get_next_baker_excluding al

let get_next_baker ?(policy = By_priority 0) = dispatch_policy policy

let get_endorsing_power b =
  fold_left_s
    (fun acc (op : Operation.packed) ->
      let (Operation_data data) = op.protocol_data in
      match data.contents with
      | Single (Endorsement _) ->
          Alpha_services.Delegate.Endorsing_power.get
            rpc_ctxt
            b
            op
            Chain_id.zero
          >>=? fun endorsement_power -> return (acc + endorsement_power)
      | _ ->
          return acc)
    0
    b.operations

module Forge = struct
  type header = {
    baker : public_key_hash;
    (* the signer of the block *)
    shell : Block_header.shell_header;
    contents : Block_header.contents;
  }

  let default_proof_of_work_nonce =
    MBytes.create Constants.proof_of_work_nonce_size

  let make_contents ?(proof_of_work_nonce = default_proof_of_work_nonce)
      ~priority ~seed_nonce_hash () =
    Block_header.{priority; proof_of_work_nonce; seed_nonce_hash}

  let make_shell ~level ~predecessor ~timestamp ~fitness ~operations_hash =
    Tezos_base.Block_header.
      {
        level;
        predecessor;
        timestamp;
        fitness;
        operations_hash;
        (* We don't care of the following values, only the shell validates them. *)
        proto_level = 0;
        validation_passes = 0;
        context = Context_hash.zero;
      }

  let set_seed_nonce_hash seed_nonce_hash {baker; shell; contents} =
    {baker; shell; contents = {contents with seed_nonce_hash}}

  let set_baker baker header = {header with baker}

  let sign_header {baker; shell; contents} =
    Account.find baker
    >>=? fun delegate ->
    let unsigned_bytes =
      Data_encoding.Binary.to_bytes_exn
        Block_header.unsigned_encoding
        (shell, contents)
    in
    let signature =
      Signature.sign
        ~watermark:Signature.(Block_header Chain_id.zero)
        delegate.sk
        unsigned_bytes
    in
    Block_header.{shell; protocol_data = {contents; signature}} |> return

  let forge_header ?(policy = By_priority 0) ?timestamp ?(operations = []) pred
      =
    dispatch_policy policy pred
    >>=? fun (pkh, priority, _timestamp) ->
    Alpha_services.Delegate.Minimal_valid_time.get rpc_ctxt pred priority 0
    >>=? fun expected_timestamp ->
    let timestamp = Option.unopt ~default:expected_timestamp timestamp in
    let level = Int32.succ pred.header.shell.level in
    ( match Fitness_repr.to_int64 pred.header.shell.fitness with
    | Ok old_fitness ->
        return
          (Fitness_repr.from_int64 (Int64.add (Int64.of_int 1) old_fitness))
    | Error _ ->
        assert false )
    >>=? fun fitness ->
    Alpha_services.Helpers.current_level ~offset:1l rpc_ctxt pred
    >>|? (function
           | {expected_commitment = true; _} ->
               Some (fst (Proto_Nonce.generate ()))
           | {expected_commitment = false; _} ->
               None)
    >>=? fun seed_nonce_hash ->
    let hashes = List.map Operation.hash_packed operations in
    let operations_hash =
      Operation_list_list_hash.compute [Operation_list_hash.compute hashes]
    in
    let shell =
      make_shell
        ~level
        ~predecessor:pred.hash
        ~timestamp
        ~fitness
        ~operations_hash
    in
    let contents = make_contents ~priority ~seed_nonce_hash () in
    return {baker = pkh; shell; contents}

  (* compatibility only, needed by incremental *)
  let contents ?(proof_of_work_nonce = default_proof_of_work_nonce)
      ?(priority = 0) ?seed_nonce_hash () =
    {Block_header.priority; proof_of_work_nonce; seed_nonce_hash}
end

(********* Genesis creation *************)

(* Hard-coded context key *)
let protocol_param_key = ["protocol_parameters"]

let check_constants_consistency constants =
  let open Constants_repr in
  let {blocks_per_cycle; blocks_per_commitment; blocks_per_roll_snapshot; _} =
    constants
  in
  Error_monad.unless (blocks_per_commitment <= blocks_per_cycle) (fun () ->
      failwith
        "Inconsistent constants : blocks per commitment must be less than \
         blocks per cycle")
  >>=? fun () ->
  Error_monad.unless (blocks_per_cycle >= blocks_per_roll_snapshot) (fun () ->
      failwith
        "Inconsistent constants : blocks per cycle must be superior than \
         blocks per roll snapshot")
  >>=? return

let initial_context ?(with_commitments = false) constants header
    initial_accounts =
  let open Tezos_protocol_alpha_parameters in
  let bootstrap_accounts =
    List.map
      (fun (Account.{pk; pkh; _}, amount) ->
        Default_parameters.make_bootstrap_account (pkh, pk, amount))
      initial_accounts
  in
  let parameters =
    Default_parameters.parameters_of_constants
      ~bootstrap_accounts
      ~with_commitments
      constants
  in
  let json = Default_parameters.json_of_parameters parameters in
  let proto_params =
    Data_encoding.Binary.to_bytes_exn Data_encoding.json json
  in
  Tezos_protocol_environment.Context.(
    let empty = Memory_context.empty in
    set empty ["version"] (MBytes.of_string "genesis")
    >>= fun ctxt -> set ctxt protocol_param_key proto_params)
  >>= fun ctxt ->
  Main.init ctxt header >|= Environment.wrap_error
  >>=? fun {context; _} -> return context

let genesis_with_parameters parameters =
  let hash =
    Block_hash.of_b58check_exn
      "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU"
  in
  let shell =
    Forge.make_shell
      ~level:0l
      ~predecessor:hash
      ~timestamp:Time.Protocol.epoch
      ~fitness:(Fitness_repr.from_int64 0L)
      ~operations_hash:Operation_list_list_hash.zero
  in
  let contents = Forge.make_contents ~priority:0 ~seed_nonce_hash:None () in
  let open Tezos_protocol_alpha_parameters in
  let json = Default_parameters.json_of_parameters parameters in
  let proto_params =
    Data_encoding.Binary.to_bytes_exn Data_encoding.json json
  in
  Tezos_protocol_environment.Context.(
    let empty = Memory_context.empty in
    set empty ["version"] (MBytes.of_string "genesis")
    >>= fun ctxt -> set ctxt protocol_param_key proto_params)
  >>= fun ctxt ->
  Main.init ctxt shell >|= Environment.wrap_error
  >>=? fun {context; _} ->
  let block =
    {
      hash;
      header = {shell; protocol_data = {contents; signature = Signature.zero}};
      operations = [];
      context;
    }
  in
  return block

(* if no parameter file is passed we check in the current directory
   where the test is run *)
let genesis ?with_commitments ?endorsers_per_block ?initial_endorsers
    ?min_proposal_quorum (initial_accounts : (Account.t * Tez_repr.t) list) =
  if initial_accounts = [] then
    Pervasives.failwith "Must have one account with a roll to bake" ;
  let open Tezos_protocol_alpha_parameters in
  let constants = Default_parameters.constants_test in
  let endorsers_per_block =
    Option.unopt ~default:constants.endorsers_per_block endorsers_per_block
  in
  let initial_endorsers =
    Option.unopt ~default:constants.initial_endorsers initial_endorsers
  in
  let min_proposal_quorum =
    Option.unopt ~default:constants.min_proposal_quorum min_proposal_quorum
  in
  let constants =
    {
      constants with
      endorsers_per_block;
      initial_endorsers;
      min_proposal_quorum;
    }
  in
  (* Check there is at least one roll *)
  ( try
      let open Test_utils in
      fold_left_s
        (fun acc (_, amount) ->
          Environment.wrap_error @@ Tez_repr.( +? ) acc amount
          >>?= fun acc ->
          if acc >= constants.tokens_per_roll then raise Exit else return acc)
        Tez_repr.zero
        initial_accounts
      >>=? fun _ ->
      failwith "Insufficient tokens in initial accounts to create one roll"
    with Exit -> return_unit )
  >>=? fun () ->
  check_constants_consistency constants
  >>=? fun () ->
  let hash =
    Block_hash.of_b58check_exn
      "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU"
  in
  let shell =
    Forge.make_shell
      ~level:0l
      ~predecessor:hash
      ~timestamp:Time.Protocol.epoch
      ~fitness:(Fitness_repr.from_int64 0L)
      ~operations_hash:Operation_list_list_hash.zero
  in
  let contents = Forge.make_contents ~priority:0 ~seed_nonce_hash:None () in
  initial_context ?with_commitments constants shell initial_accounts
  >>=? fun context ->
  let block =
    {
      hash;
      header = {shell; protocol_data = {contents; signature = Signature.zero}};
      operations = [];
      context;
    }
  in
  return block

(********* Baking *************)

let apply header ?(operations = []) pred =
  (let open Environment.Error_monad in
  Main.begin_application
    ~chain_id:Chain_id.zero
    ~predecessor_context:pred.context
    ~predecessor_fitness:pred.header.shell.fitness
    ~predecessor_timestamp:pred.header.shell.timestamp
    header
  >>=? fun vstate ->
  fold_left_s
    (fun vstate op ->
      apply_operation vstate op >>=? fun (state, _result) -> return state)
    vstate
    operations
  >>=? fun vstate ->
  Main.finalize_block vstate
  >>=? fun (validation, _result) -> return validation.context)
  >|= Environment.wrap_error
  >>|? fun context ->
  let hash = Block_header.hash header in
  {hash; header; operations; context}

let bake ?policy ?timestamp ?operation ?operations pred =
  let operations =
    match (operation, operations) with
    | (Some op, Some ops) ->
        Some (op :: ops)
    | (Some op, None) ->
        Some [op]
    | (None, Some ops) ->
        Some ops
    | (None, None) ->
        None
  in
  Forge.forge_header ?timestamp ?policy ?operations pred
  >>=? fun header ->
  Forge.sign_header header >>=? fun header -> apply header ?operations pred

(********** Cycles ****************)

(* This function is duplicated from Context to avoid a cyclic dependency *)
let get_constants b = Alpha_services.Constants.all rpc_ctxt b

let bake_n ?policy n b =
  Error_monad.fold_left_s (fun b _ -> bake ?policy b) b (1 -- n)

let bake_until_cycle_end ?policy b =
  get_constants b
  >>=? fun Constants.{parametric = {blocks_per_cycle; _}; _} ->
  let current_level = b.header.shell.level in
  let current_level = Int32.rem current_level blocks_per_cycle in
  let delta = Int32.sub blocks_per_cycle current_level in
  bake_n ?policy (Int32.to_int delta) b

let bake_until_n_cycle_end ?policy n b =
  Error_monad.fold_left_s (fun b _ -> bake_until_cycle_end ?policy b) b (1 -- n)

let bake_until_cycle ?policy cycle (b : t) =
  get_constants b
  >>=? fun Constants.{parametric = {blocks_per_cycle; _}; _} ->
  let rec loop (b : t) =
    let current_cycle =
      let current_level = b.header.shell.level in
      let current_cycle = Int32.div current_level blocks_per_cycle in
      current_cycle
    in
    if Int32.equal (Cycle.to_int32 cycle) current_cycle then return b
    else bake_until_cycle_end ?policy b >>=? fun b -> loop b
  in
  loop b
block_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Protocol.

Module Proto_Nonce := Nonce.

Import Alpha_context.

Record t := {
  hash : Tezos_base__TzPervasives.Block_hash.t;
  header : Tezos_protocol_alpha.Protocol.Alpha_context.Block_header.t;
  operations : list Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed;
  context : Tezos_protocol_environment.Context.t }.

Definition block := t.

Definition rpc_context (block : t)
  : Tezos_protocol_alpha.Protocol.Environment.Updater.rpc_context :=
  {| Environment.Updater.block_hash := hash block;
    Environment.Updater.block_header := shell (header block);
    Environment.Updater.context := context block |}.

Definition rpc_ctxt
  : Tezos_protocol_alpha.Protocol.Environment.proto_rpc_context_of_directory t :=
  (* ❌ Creation of new objects is not handled *)
  new rpc_context rpc_services.

Inductive baker_policy : Type :=
| By_priority : Z -> baker_policy
| By_account : Tezos_protocol_alpha.Protocol.Alpha_context.public_key_hash ->
  baker_policy
| Excluding : list Tezos_protocol_alpha.Protocol.Alpha_context.public_key_hash
  -> baker_policy.

Definition get_next_baker_by_priority (priority : Z) (block : t)
  : Lwt.t
    (Tezos_base__TzPervasives.tzresult
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
        * Z * Tezos_raw_protocol_alpha.Alpha_context.Timestamp.t)) :=
  op_gtgteqquestion
    (Alpha_services.Delegate.Baking_rights.get rpc_ctxt None None None
      (Some true) (Some (Z.add priority 1)) block)
    (fun bakers =>
      let '{|
        Alpha_services.Delegate.Baking_rights.delegate := pkh;
          Alpha_services.Delegate.Baking_rights.timestamp := timestamp
          |} :=
        List.find
          (fun function_parameter =>
            let '{| Alpha_services.Delegate.Baking_rights.priority := p |} :=
              function_parameter in
            equiv_decb p priority) bakers in
      __return
        (pkh, priority, (Option.unopt_exn (OCaml.Failure "" % string) timestamp))).

Definition get_next_baker_by_account
  (pkh : Tezos_protocol_environment_alpha__Environment.Signature.public_key_hash)
  (block : t)
  : Lwt.t
    (Tezos_base__TzPervasives.tzresult
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
        * Z * Tezos_raw_protocol_alpha.Alpha_context.Timestamp.t)) :=
  op_gtgteqquestion
    (Alpha_services.Delegate.Baking_rights.get rpc_ctxt None None
      (Some (cons pkh [])) None (Some 256) block)
    (fun bakers =>
      let '{|
        Alpha_services.Delegate.Baking_rights.delegate := pkh;
          Alpha_services.Delegate.Baking_rights.priority := priority;
          Alpha_services.Delegate.Baking_rights.timestamp := timestamp
          |} := List.hd bakers in
      __return
        (pkh, priority, (Option.unopt_exn (OCaml.Failure "" % string) timestamp))).

Definition get_next_baker_excluding
  (excludes :
    list
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (block : t)
  : Lwt.t
    (Tezos_base__TzPervasives.tzresult
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
        * Z * Tezos_raw_protocol_alpha.Alpha_context.Timestamp.t)) :=
  op_gtgteqquestion
    (Alpha_services.Delegate.Baking_rights.get rpc_ctxt None None None None
      (Some 256) block)
    (fun bakers =>
      let '{|
        Alpha_services.Delegate.Baking_rights.delegate := pkh;
          Alpha_services.Delegate.Baking_rights.priority := priority;
          Alpha_services.Delegate.Baking_rights.timestamp := timestamp
          |} :=
        List.find
          (fun function_parameter =>
            let '{|
              Alpha_services.Delegate.Baking_rights.delegate := delegate |} :=
              function_parameter in
            negb (List.mem delegate excludes)) bakers in
      __return
        (pkh, priority, (Option.unopt_exn (OCaml.Failure "" % string) timestamp))).

Definition dispatch_policy (function_parameter : baker_policy)
  : t ->
    Lwt.t
      (Tezos_base__TzPervasives.tzresult
        (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
          * Z * Tezos_raw_protocol_alpha.Alpha_context.Timestamp.t)) :=
  match function_parameter with
  | By_priority p => get_next_baker_by_priority p
  | By_account a => get_next_baker_by_account a
  | Excluding al => get_next_baker_excluding al
  end.

Definition get_next_baker (op_staroptstar : option baker_policy)
  : t ->
    Lwt.t
      (Tezos_base__TzPervasives.tzresult
        (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
          * Z * Tezos_raw_protocol_alpha.Alpha_context.Timestamp.t)) :=
  let policy :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => By_priority 0
    end in
  dispatch_policy policy.

Definition get_endorsing_power (b : t)
  : Lwt.t (Tezos_base__TzPervasives.tzresult Z) :=
  fold_left_s
    (fun acc =>
      fun op =>
        let 'Tezos_protocol_alpha.Protocol.Alpha_context.Operation_data data :=
          protocol_data op in
        match contents data with
        |
          Tezos_protocol_alpha.Protocol.Alpha_context.Single
            (Tezos_protocol_alpha.Protocol.Alpha_context.Endorsement _) =>
          op_gtgteqquestion
            (Alpha_services.Delegate.Endorsing_power.get rpc_ctxt b op
              Chain_id.zero)
            (fun endorsement_power => __return (Z.add acc endorsement_power))
        | _ => __return acc
        end) 0 (operations b).

Module Forge.
  Record header := {
    baker : Tezos_protocol_alpha.Protocol.Alpha_context.public_key_hash;
    shell :
      Tezos_protocol_alpha.Protocol.Alpha_context.Block_header.shell_header;
    contents : Tezos_protocol_alpha.Protocol.Alpha_context.Block_header.contents
    }.
  
  Definition default_proof_of_work_nonce : Tezos_base__TzPervasives.MBytes.t :=
    MBytes.create Constants.proof_of_work_nonce_size.
  
  Definition make_contents
    (op_staroptstar : option Tezos_base__TzPervasives.MBytes.t)
    : Z ->
      option Tezos_raw_protocol_alpha.Nonce_hash.t ->
        unit ->
          Tezos_protocol_alpha.Protocol.Alpha_context.Block_header.contents :=
    let proof_of_work_nonce :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => default_proof_of_work_nonce
      end in
    fun priority =>
      fun seed_nonce_hash =>
        fun function_parameter =>
          let 'tt := function_parameter in
          {| priority := priority; seed_nonce_hash := seed_nonce_hash;
            proof_of_work_nonce := proof_of_work_nonce |}.
  
  Definition make_shell
    (level : Stdlib.Int32.t) (predecessor : Tezos_crypto.Block_hash.t)
    (timestamp : Tezos_base.Time.Protocol.t) (fitness : Tezos_base.Fitness.t)
    (operations_hash : Tezos_crypto.Operation_list_list_hash.t)
    : Tezos_base.Block_header.shell_header :=
    {| level := level; proto_level := 0; predecessor := predecessor;
      timestamp := timestamp; validation_passes := 0;
      operations_hash := operations_hash; fitness := fitness;
      context := Context_hash.zero |}.
  
  Definition set_seed_nonce_hash
    (seed_nonce_hash : option Tezos_raw_protocol_alpha.Nonce_hash.t)
    (function_parameter : header) : header :=
    let '{| baker := baker; shell := shell; contents := contents |} :=
      function_parameter in
    {| baker := baker; shell := shell;
      contents :=
        (* ❌ Record substitution not handled *)
        record_substitution |}.
  
  Definition set_baker
    (baker : Tezos_protocol_alpha.Protocol.Alpha_context.public_key_hash)
    (header : header) : header :=
    (* ❌ Record substitution not handled *)
    record_substitution.
  
  Definition sign_header (function_parameter : header)
    : Lwt.t
      (Tezos_base__TzPervasives.tzresult
        Tezos_protocol_alpha.Protocol.Alpha_context.Block_header.t) :=
    let '{| baker := baker; shell := shell; contents := contents |} :=
      function_parameter in
    op_gtgteqquestion (Account.find baker)
      (fun delegate =>
        let unsigned_bytes :=
          Data_encoding.Binary.to_bytes_exn Block_header.unsigned_encoding
            (shell, contents) in
        let signature :=
          Signature.sign
            (Some
              (Tezos_base__TzPervasives.Signature.Block_header Chain_id.zero))
            (sk delegate) unsigned_bytes in
        OCaml.Stdlib.reverse_apply
          {| shell := shell;
            protocol_data := {| contents := contents; signature := signature |}
            |} __return).
  
  Definition forge_header (op_staroptstar : option baker_policy)
    : option Tezos_protocol_environment_alpha__Environment.Time.t ->
      option (list Tezos_raw_protocol_alpha__Alpha_context.packed_operation) ->
        t -> Lwt.t (Tezos_base__TzPervasives.tzresult header) :=
    let policy :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => By_priority 0
      end in
    fun timestamp =>
      fun op_staroptstar =>
        let operations :=
          match op_staroptstar with
          | Some op_starsthstar => op_starsthstar
          | None => []
          end in
        fun pred =>
          op_gtgteqquestion (dispatch_policy policy pred)
            (fun function_parameter =>
              let '(pkh, priority, _timestamp) := function_parameter in
              op_gtgteqquestion
                (Alpha_services.Delegate.Minimal_valid_time.get rpc_ctxt pred
                  priority 0)
                (fun expected_timestamp =>
                  let timestamp := Option.unopt expected_timestamp timestamp in
                  let level := Int32.succ (level (shell (header pred))) in
                  op_gtgteqquestion
                    match Fitness_repr.to_int64 (fitness (shell (header pred)))
                      with
                    | Stdlib.Ok old_fitness =>
                      __return
                        (Fitness_repr.from_int64
                          (Int64.add (Int64.of_int 1) old_fitness))
                    | Stdlib.Error _ =>
                      (* ❌ Assert instruction is not handled. *)
                      assert false
                    end
                    (fun fitness =>
                      op_gtgteqquestion
                        (op_gtgtpipequestion
                          (Alpha_services.Helpers.current_level rpc_ctxt
                            (Some
                              (* ❌ Constant of type int32 is converted to int *)
                              1) pred)
                          (fun function_parameter =>
                            match function_parameter with
                            | {| expected_commitment := true |} =>
                              Some (fst (Proto_Nonce.generate tt))
                            | {| expected_commitment := false |} => None
                            end))
                        (fun seed_nonce_hash =>
                          let hashes :=
                            List.map Operation.hash_packed operations in
                          let operations_hash :=
                            Operation_list_list_hash.compute
                              (cons (Operation_list_hash.compute hashes) []) in
                          let shell :=
                            make_shell level (hash pred) timestamp fitness
                              operations_hash in
                          let contents :=
                            make_contents None priority seed_nonce_hash tt in
                          __return
                            {| baker := pkh; shell := shell;
                              contents := contents |})))).
  
  Definition contents
    (op_staroptstar : option Tezos_base__TzPervasives.MBytes.t)
    : option Z ->
      option Tezos_raw_protocol_alpha.Nonce_hash.t ->
        unit ->
          Tezos_protocol_alpha.Protocol.Alpha_context.Block_header.contents :=
    let proof_of_work_nonce :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => default_proof_of_work_nonce
      end in
    fun op_staroptstar =>
      let priority :=
        match op_staroptstar with
        | Some op_starsthstar => op_starsthstar
        | None => 0
        end in
      fun seed_nonce_hash =>
        fun function_parameter =>
          let 'tt := function_parameter in
          {| Block_header.priority := priority;
            Block_header.seed_nonce_hash := seed_nonce_hash;
            Block_header.proof_of_work_nonce := proof_of_work_nonce |}.
End Forge.

Definition protocol_param_key : list string :=
  cons "protocol_parameters" % string [].

Definition check_constants_consistency
  (constants : Tezos_protocol_alpha.Protocol.Constants_repr.parametric)
  : Lwt.t (Tezos_base__TzPervasives.tzresult unit) :=
  let '{|
    blocks_per_cycle := blocks_per_cycle;
      blocks_per_commitment := blocks_per_commitment;
      blocks_per_roll_snapshot := blocks_per_roll_snapshot
      |} := constants in
  op_gtgteqquestion
    (Error_monad.unless (OCaml.Stdlib.le blocks_per_commitment blocks_per_cycle)
      (fun function_parameter =>
        let 'tt := function_parameter in
        failwith
          (CamlinternalFormatBasics.Format
            (CamlinternalFormatBasics.String_literal
              "Inconsistent constants : blocks per commitment must be less than blocks per cycle"
                % string CamlinternalFormatBasics.End_of_format)
            "Inconsistent constants : blocks per commitment must be less than blocks per cycle"
              % string)))
    (fun function_parameter =>
      let 'tt := function_parameter in
      op_gtgteqquestion
        (Error_monad.unless
          (OCaml.Stdlib.ge blocks_per_cycle blocks_per_roll_snapshot)
          (fun function_parameter =>
            let 'tt := function_parameter in
            failwith
              (CamlinternalFormatBasics.Format
                (CamlinternalFormatBasics.String_literal
                  "Inconsistent constants : blocks per cycle must be superior than blocks per roll snapshot"
                    % string CamlinternalFormatBasics.End_of_format)
                "Inconsistent constants : blocks per cycle must be superior than blocks per roll snapshot"
                  % string))) __return).

Definition initial_context (op_staroptstar : option bool)
  : Tezos_protocol_alpha.Protocol.Constants_repr.parametric ->
    Tezos_protocol_environment_alpha__Environment.Block_header.shell_header ->
      list
        (Tezos_alpha_test_helpers.Account.t *
          Tezos_protocol_alpha.Protocol.Tez_repr.t) ->
        Lwt.t
          (Tezos_base__TzPervasives.tzresult
            Tezos_protocol_environment_alpha__Environment.Context.t) :=
  let with_commitments :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => false
    end in
  fun constants =>
    fun header =>
      fun initial_accounts =>
        let bootstrap_accounts :=
          List.map
            (fun function_parameter =>
              let '({| pkh := pkh; pk := pk |}, amount) := function_parameter in
              Default_parameters.make_bootstrap_account (pkh, pk, amount))
            initial_accounts in
        let parameters :=
          Default_parameters.parameters_of_constants (Some bootstrap_accounts)
            None (Some with_commitments) constants in
        let json := Default_parameters.json_of_parameters parameters in
        let proto_params :=
          Data_encoding.Binary.to_bytes_exn Data_encoding.json json in
        op_gtgteq
          (let empty := Memory_context.empty in
          op_gtgteq
            (set empty (cons "version" % string [])
              (MBytes.of_string "genesis" % string))
            (fun ctxt => set ctxt protocol_param_key proto_params))
          (fun ctxt =>
            op_gtgteqquestion
              (op_gtpipeeq (Main.init ctxt header) Environment.wrap_error)
              (fun function_parameter =>
                let '{| context := context |} := function_parameter in
                __return context)).

Definition genesis_with_parameters
  (parameters : Tezos_protocol_alpha.Protocol.Parameters_repr.t)
  : Lwt.t (Tezos_base__TzPervasives.tzresult t) :=
  let hash :=
    Block_hash.of_b58check_exn
      "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU" % string in
  let shell :=
    Forge.make_shell
      (* ❌ Constant of type int32 is converted to int *)
      0 hash Time.Protocol.epoch
      (Fitness_repr.from_int64
        (* ❌ Constant of type int64 is converted to int *)
        0) Operation_list_list_hash.zero in
  let contents := Forge.make_contents None 0 None tt in
  let json := Default_parameters.json_of_parameters parameters in
  let proto_params := Data_encoding.Binary.to_bytes_exn Data_encoding.json json
    in
  op_gtgteq
    (let empty := Memory_context.empty in
    op_gtgteq
      (set empty (cons "version" % string [])
        (MBytes.of_string "genesis" % string))
      (fun ctxt => set ctxt protocol_param_key proto_params))
    (fun ctxt =>
      op_gtgteqquestion
        (op_gtpipeeq (Main.init ctxt shell) Environment.wrap_error)
        (fun function_parameter =>
          let '{| context := context |} := function_parameter in
          let block :=
            {| hash := hash;
              header :=
                {| shell := shell;
                  protocol_data :=
                    {| contents := contents; signature := Signature.zero |} |};
              operations := []; context := context |} in
          __return block)).

Definition genesis
  (with_commitments : option bool) (endorsers_per_block : option Z)
  (initial_endorsers : option Z) (min_proposal_quorum : option int32)
  (initial_accounts :
    list
      (Tezos_alpha_test_helpers.Account.t *
        Tezos_protocol_alpha.Protocol.Tez_repr.t))
  : Lwt.t (Tezos_base__TzPervasives.tzresult t) :=
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    if equiv_decb initial_accounts [] then
      Pervasives.failwith "Must have one account with a roll to bake" % string
    else
      tt in
  let constants := Default_parameters.constants_test in
  let endorsers_per_block :=
    Option.unopt (endorsers_per_block constants) endorsers_per_block in
  let initial_endorsers :=
    Option.unopt (initial_endorsers constants) initial_endorsers in
  let min_proposal_quorum :=
    Option.unopt (min_proposal_quorum constants) min_proposal_quorum in
  let constants :=
    (* ❌ Record substitution not handled *)
    record_substitution in
  op_gtgteqquestion
    (* ❌ Try-with are not handled *)
    (try
      (op_gtgteqquestion
        (fold_left_s
          (fun acc =>
            fun function_parameter =>
              let '(_, amount) := function_parameter in
              op_gtgtquestioneq
                (apply Environment.wrap_error
                  (Tez_repr.op_plusquestion acc amount))
                (fun acc =>
                  if OCaml.Stdlib.ge acc (tokens_per_roll constants) then
                    Stdlib.raise Exit
                  else
                    __return acc)) Tez_repr.zero initial_accounts)
        (fun function_parameter =>
          let '_ := function_parameter in
          failwith
            (CamlinternalFormatBasics.Format
              (CamlinternalFormatBasics.String_literal
                "Insufficient tokens in initial accounts to create one roll" %
                  string CamlinternalFormatBasics.End_of_format)
              "Insufficient tokens in initial accounts to create one roll" %
                string))))
    (fun function_parameter =>
      let 'tt := function_parameter in
      op_gtgteqquestion (check_constants_consistency constants)
        (fun function_parameter =>
          let 'tt := function_parameter in
          let hash :=
            Block_hash.of_b58check_exn
              "BLockGenesisGenesisGenesisGenesisGenesisCCCCCeZiLHU" % string in
          let shell :=
            Forge.make_shell
              (* ❌ Constant of type int32 is converted to int *)
              0 hash Time.Protocol.epoch
              (Fitness_repr.from_int64
                (* ❌ Constant of type int64 is converted to int *)
                0) Operation_list_list_hash.zero in
          let contents := Forge.make_contents None 0 None tt in
          op_gtgteqquestion
            (initial_context with_commitments constants shell initial_accounts)
            (fun context =>
              let block :=
                {| hash := hash;
                  header :=
                    {| shell := shell;
                      protocol_data :=
                        {| contents := contents; signature := Signature.zero |}
                      |}; operations := []; context := context |} in
              __return block))).

Definition apply
  (header : Tezos_protocol_alpha.Protocol.Main.block_header)
  (op_staroptstar :
    option (list Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed))
  : t -> Lwt.t (Tezos_base__TzPervasives.tzresult t) :=
  let operations :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => []
    end in
  fun pred =>
    op_gtgtpipequestion
      (op_gtpipeeq
        (op_gtgteqquestion
          (Main.begin_application Chain_id.zero (context pred)
            (timestamp (shell (header pred))) (fitness (shell (header pred)))
            header)
          (fun vstate =>
            op_gtgteqquestion
              (fold_left_s
                (fun vstate =>
                  fun op =>
                    op_gtgteqquestion (apply_operation vstate op)
                      (fun function_parameter =>
                        let '(state, _result) := function_parameter in
                        __return state)) vstate operations)
              (fun vstate =>
                op_gtgteqquestion (Main.finalize_block vstate)
                  (fun function_parameter =>
                    let '(validation, _result) := function_parameter in
                    __return (context validation))))) Environment.wrap_error)
      (fun context =>
        let hash := Block_header.hash header in
        {| hash := hash; header := header; operations := operations;
          context := context |}).

Definition bake
  (policy : option baker_policy)
  (timestamp : option Tezos_protocol_environment_alpha__Environment.Time.t)
  (operation :
    option Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed)
  (operations :
    option (list Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed))
  (pred : t) : Lwt.t (Tezos_base__TzPervasives.tzresult t) :=
  let operations :=
    match (operation, operations) with
    | (Some op, Some ops) => Some (cons op ops)
    | (Some op, None) => Some (cons op [])
    | (None, Some ops) => Some ops
    | (None, None) => None
    end in
  op_gtgteqquestion (Forge.forge_header policy timestamp operations pred)
    (fun header =>
      op_gtgteqquestion (Forge.sign_header header)
        (fun header => apply header operations pred)).

Definition get_constants (b : t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Constants.t) :=
  Alpha_services.Constants.all rpc_ctxt b.

Definition bake_n (policy : option baker_policy) (n : Z) (b : t)
  : Lwt.t (Tezos_base__TzPervasives.Error_monad.tzresult t) :=
  Error_monad.fold_left_s
    (fun b =>
      fun function_parameter =>
        let '_ := function_parameter in
        bake policy None None None b) b (op_minusminus 1 n).

Definition bake_until_cycle_end (policy : option baker_policy) (b : t)
  : Lwt.t (Tezos_base__TzPervasives.tzresult t) :=
  op_gtgteqquestion (get_constants b)
    (fun function_parameter =>
      let '{| parametric := {| blocks_per_cycle := blocks_per_cycle |} |} :=
        function_parameter in
      let current_level := level (shell (header b)) in
      let current_level := Int32.rem current_level blocks_per_cycle in
      let delta := Int32.sub blocks_per_cycle current_level in
      bake_n policy (Int32.to_int delta) b).

Definition bake_until_n_cycle_end (policy : option baker_policy) (n : Z) (b : t)
  : Lwt.t (Tezos_base__TzPervasives.Error_monad.tzresult t) :=
  Error_monad.fold_left_s
    (fun b =>
      fun function_parameter =>
        let '_ := function_parameter in
        bake_until_cycle_end policy b) b (op_minusminus 1 n).

Definition bake_until_cycle
  (policy : option baker_policy)
  (cycle : Tezos_protocol_alpha.Protocol.Alpha_context.Cycle.cycle) (b : t)
  : Lwt.t (Tezos_base__TzPervasives.tzresult t) :=
  op_gtgteqquestion (get_constants b)
    (fun function_parameter =>
      let '{| parametric := {| blocks_per_cycle := blocks_per_cycle |} |} :=
        function_parameter in
      let fix loop (b : t) : Lwt.t (Tezos_base__TzPervasives.tzresult t) :=
        let current_cycle :=
          let current_level := level (shell (header b)) in
          let current_cycle := Int32.div current_level blocks_per_cycle in
          current_cycle in
        if Int32.equal (Cycle.to_int32 cycle) current_cycle then
          __return b
        else
          op_gtgteqquestion (bake_until_cycle_end policy b) (fun b => loop b) in
      loop b).
test/helpers/block.mli success 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol
open Alpha_context

type t = {
  hash : Block_hash.t;
  header : Block_header.t;
  operations : Operation.packed list;
  context : Tezos_protocol_environment.Context.t;  (** Resulting context *)
}

type block = t

val rpc_ctxt : t Environment.RPC_context.simple

(** Policies to select the next baker:
    - [By_priority p] selects the baker at priority [p]
    - [By_account pkh] selects the first slot for baker [pkh]
    - [Excluding pkhs] selects the first baker that doesn't belong to [pkhs]
*)
type baker_policy =
  | By_priority of int
  | By_account of public_key_hash
  | Excluding of public_key_hash list

(** Returns (account, priority, timestamp) of the next baker given
    a policy, defaults to By_priority 0. *)
val get_next_baker :
  ?policy:baker_policy ->
  t ->
  (public_key_hash * int * Time.Protocol.t) tzresult Lwt.t

val get_endorsing_power : block -> int tzresult Lwt.t

module Forge : sig
  val contents :
    ?proof_of_work_nonce:MBytes.t ->
    ?priority:int ->
    ?seed_nonce_hash:Nonce_hash.t ->
    unit ->
    Block_header.contents

  type header

  (** Forges a correct header following the policy.
      The header can then be modified and applied with [apply]. *)
  val forge_header :
    ?policy:baker_policy ->
    ?timestamp:Timestamp.time ->
    ?operations:Operation.packed list ->
    t ->
    header tzresult Lwt.t

  (** Sets uniquely seed_nonce_hash of a header *)
  val set_seed_nonce_hash : Nonce_hash.t option -> header -> header

  (** Sets the baker that will sign the header to an arbitrary pkh *)
  val set_baker : public_key_hash -> header -> header

  (** Signs the header with the key of the baker configured in the header.
      The header can no longer be modified, only applied. *)
  val sign_header : header -> Block_header.block_header tzresult Lwt.t
end

(** [genesis <opts> accounts] : generates an initial block with the
    given constants [<opts>] and initializes [accounts] with their
    associated amounts.
*)
val genesis :
  ?with_commitments:bool ->
  ?endorsers_per_block:int ->
  ?initial_endorsers:int ->
  ?min_proposal_quorum:int32 ->
  (Account.t * Tez_repr.tez) list ->
  block tzresult Lwt.t

val genesis_with_parameters : Parameters_repr.t -> block tzresult Lwt.t

(** Applies a signed header and its operations to a block and
    obtains a new block *)
val apply :
  Block_header.block_header ->
  ?operations:Operation.packed list ->
  t ->
  t tzresult Lwt.t

(**
   [bake b] returns a block [b'] which has as predecessor block [b].
   Optional parameter [policy] allows to pick the next baker in several ways.
   This function bundles together [forge_header], [sign_header] and [apply].
   These functions should be used instead of bake to craft unusual blocks for
   testing together with setters for properties of the headers.
   For examples see seed.ml or double_baking.ml
*)
val bake :
  ?policy:baker_policy ->
  ?timestamp:Timestamp.time ->
  ?operation:Operation.packed ->
  ?operations:Operation.packed list ->
  t ->
  t tzresult Lwt.t

(** Bakes [n] blocks. *)
val bake_n : ?policy:baker_policy -> int -> t -> block tzresult Lwt.t

(** Given a block [b] at level [l] bakes enough blocks to complete a cycle,
    that is [blocks_per_cycle - (l % blocks_per_cycle)]. *)
val bake_until_cycle_end : ?policy:baker_policy -> t -> t tzresult Lwt.t

(** Bakes enough blocks to end [n] cycles. *)
val bake_until_n_cycle_end :
  ?policy:baker_policy -> int -> t -> t tzresult Lwt.t

(** Bakes enough blocks to reach the cycle. *)
val bake_until_cycle : ?policy:baker_policy -> Cycle.t -> t -> t tzresult Lwt.t
block_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Record t := {
  hash : Tezos_base__TzPervasives.Block_hash.t;
  header : Tezos_protocol_alpha.Protocol.Alpha_context.Block_header.t;
  operations : list Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed;
  context : Tezos_protocol_environment.Context.t }.

Definition block := t.

Parameter rpc_ctxt :
Tezos_protocol_alpha.Protocol.Environment.RPC_context.simple t.

Inductive baker_policy : Type :=
| By_priority : Z -> baker_policy
| By_account : Tezos_protocol_alpha.Protocol.Alpha_context.public_key_hash ->
  baker_policy
| Excluding : list Tezos_protocol_alpha.Protocol.Alpha_context.public_key_hash
  -> baker_policy.

Parameter get_next_baker :
option baker_policy ->
  t ->
    Lwt.t
      (Tezos_base__TzPervasives.tzresult
        (Tezos_protocol_alpha.Protocol.Alpha_context.public_key_hash * Z *
          Tezos_base__TzPervasives.Time.Protocol.t)).

Parameter get_endorsing_power :
block -> Lwt.t (Tezos_base__TzPervasives.tzresult Z).

Module Forge.
  Parameter contents : option Tezos_base__TzPervasives.MBytes.t ->
    option Z ->
      option Tezos_protocol_alpha.Protocol.Nonce_hash.t ->
        unit ->
          Tezos_protocol_alpha.Protocol.Alpha_context.Block_header.contents.
  
  Parameter header : Type.
  
  Parameter forge_header : option baker_policy ->
    option Tezos_protocol_alpha.Protocol.Alpha_context.Timestamp.time ->
      option (list Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed)
        -> t -> Lwt.t (Tezos_base__TzPervasives.tzresult header).
  
  Parameter set_seed_nonce_hash : option
    Tezos_protocol_alpha.Protocol.Nonce_hash.t -> header -> header.
  
  Parameter set_baker : Tezos_protocol_alpha.Protocol.Alpha_context.public_key_hash
    -> header -> header.
  
  Parameter sign_header : header ->
    Lwt.t
      (Tezos_base__TzPervasives.tzresult
        Tezos_protocol_alpha.Protocol.Alpha_context.Block_header.block_header).
End Forge.

Parameter genesis :
option bool ->
  option Z ->
    option Z ->
      option int32 ->
        list
          (Tezos_alpha_test_helpers.Account.t *
            Tezos_protocol_alpha.Protocol.Tez_repr.tez) ->
          Lwt.t (Tezos_base__TzPervasives.tzresult block).

Parameter genesis_with_parameters :
Tezos_protocol_alpha.Protocol.Parameters_repr.t ->
  Lwt.t (Tezos_base__TzPervasives.tzresult block).

Parameter apply :
Tezos_protocol_alpha.Protocol.Alpha_context.Block_header.block_header ->
  option (list Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed) ->
    t -> Lwt.t (Tezos_base__TzPervasives.tzresult t).

Parameter bake :
option baker_policy ->
  option Tezos_protocol_alpha.Protocol.Alpha_context.Timestamp.time ->
    option Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed ->
      option (list Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed)
        -> t -> Lwt.t (Tezos_base__TzPervasives.tzresult t).

Parameter bake_n :
option baker_policy -> Z -> t -> Lwt.t (Tezos_base__TzPervasives.tzresult block).

Parameter bake_until_cycle_end :
option baker_policy -> t -> Lwt.t (Tezos_base__TzPervasives.tzresult t).

Parameter bake_until_n_cycle_end :
option baker_policy -> Z -> t -> Lwt.t (Tezos_base__TzPervasives.tzresult t).

Parameter bake_until_cycle :
option baker_policy ->
  Tezos_protocol_alpha.Protocol.Alpha_context.Cycle.t ->
    t -> Lwt.t (Tezos_base__TzPervasives.tzresult t).
test/helpers/context.ml 20 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol
open Alpha_context

type t = B of Block.t | I of Incremental.t

let branch = function B b -> b.hash | I i -> (Incremental.predecessor i).hash

let level = function B b -> b.header.shell.level | I i -> Incremental.level i

let get_level ctxt =
  level ctxt |> Raw_level.of_int32 |> Environment.wrap_error |> Lwt.return

let rpc_ctxt =
  object
    method call_proto_service0
        : 'm 'q 'i 'o.
          ( ([< RPC_service.meth] as 'm),
            Environment.RPC_context.t,
            Environment.RPC_context.t,
            'q,
            'i,
            'o )
          RPC_service.t -> t -> 'q -> 'i -> 'o tzresult Lwt.t =
      fun s pr q i ->
        match pr with
        | B b ->
            Block.rpc_ctxt#call_proto_service0 s b q i
        | I b ->
            Incremental.rpc_ctxt#call_proto_service0 s b q i

    method call_proto_service1
        : 'm 'a 'q 'i 'o.
          ( ([< RPC_service.meth] as 'm),
            Environment.RPC_context.t,
            Environment.RPC_context.t * 'a,
            'q,
            'i,
            'o )
          RPC_service.t -> t -> 'a -> 'q -> 'i -> 'o tzresult Lwt.t =
      fun s pr a q i ->
        match pr with
        | B bl ->
            Block.rpc_ctxt#call_proto_service1 s bl a q i
        | I bl ->
            Incremental.rpc_ctxt#call_proto_service1 s bl a q i

    method call_proto_service2
        : 'm 'a 'b 'q 'i 'o.
          ( ([< RPC_service.meth] as 'm),
            Environment.RPC_context.t,
            (Environment.RPC_context.t * 'a) * 'b,
            'q,
            'i,
            'o )
          RPC_service.t -> t -> 'a -> 'b -> 'q -> 'i -> 'o tzresult Lwt.t =
      fun s pr a b q i ->
        match pr with
        | B bl ->
            Block.rpc_ctxt#call_proto_service2 s bl a b q i
        | I bl ->
            Incremental.rpc_ctxt#call_proto_service2 s bl a b q i

    method call_proto_service3
        : 'm 'a 'b 'c 'q 'i 'o.
          ( ([< RPC_service.meth] as 'm),
            Environment.RPC_context.t,
            ((Environment.RPC_context.t * 'a) * 'b) * 'c,
            'q,
            'i,
            'o )
          RPC_service.t -> t -> 'a -> 'b -> 'c -> 'q -> 'i -> 'o tzresult Lwt.t
        =
      fun s pr a b c q i ->
        match pr with
        | B bl ->
            Block.rpc_ctxt#call_proto_service3 s bl a b c q i
        | I bl ->
            Incremental.rpc_ctxt#call_proto_service3 s bl a b c q i
  end

let get_endorsers ctxt =
  Alpha_services.Delegate.Endorsing_rights.get rpc_ctxt ctxt

let get_endorser ctxt =
  Alpha_services.Delegate.Endorsing_rights.get rpc_ctxt ctxt
  >>=? fun endorsers ->
  let endorser = List.hd endorsers in
  return (endorser.delegate, endorser.slots)

let get_bakers ctxt =
  Alpha_services.Delegate.Baking_rights.get ~max_priority:256 rpc_ctxt ctxt
  >>=? fun bakers ->
  return
    (List.map
       (fun p -> p.Alpha_services.Delegate.Baking_rights.delegate)
       bakers)

let get_seed_nonce_hash ctxt =
  let header =
    match ctxt with B {header; _} -> header | I i -> Incremental.header i
  in
  match header.protocol_data.contents.seed_nonce_hash with
  | None ->
      failwith "No committed nonce"
  | Some hash ->
      return hash

let get_seed ctxt = Alpha_services.Seed.get rpc_ctxt ctxt

let get_constants ctxt = Alpha_services.Constants.all rpc_ctxt ctxt

let get_minimal_valid_time ctxt ~priority ~endorsing_power =
  Alpha_services.Delegate.Minimal_valid_time.get
    rpc_ctxt
    ctxt
    priority
    endorsing_power

let get_baking_reward ctxt ~priority ~endorsing_power =
  get_constants ctxt
  >>=? fun Constants.{parametric = {block_reward; endorsers_per_block; _}; _} ->
  let prio_factor_denominator = Int64.(succ (of_int priority)) in
  let endo_factor_numerator =
    Int64.of_int (8 + (2 * endorsing_power / endorsers_per_block))
  in
  let endo_factor_denominator = 10L in
  Lwt.return
    Test_tez.Tez.(
      block_reward *? endo_factor_numerator
      >>? fun val1 ->
      val1 /? endo_factor_denominator
      >>? fun val2 -> val2 /? prio_factor_denominator)

let get_endorsing_reward ctxt ~priority ~endorsing_power =
  get_constants ctxt
  >>=? fun Constants.{parametric = {endorsement_reward; _}; _} ->
  let open Test_utils in
  Test_tez.Tez.(
    (endorsement_reward /? Int64.(succ (of_int priority)))
    >>?= fun reward_per_slot ->
    reward_per_slot *? Int64.of_int endorsing_power
    >>?= fun reward -> return reward)

(* Voting *)

module Vote = struct
  let get_ballots ctxt = Alpha_services.Voting.ballots rpc_ctxt ctxt

  let get_ballot_list ctxt = Alpha_services.Voting.ballot_list rpc_ctxt ctxt

  let get_voting_period ctxt =
    Alpha_services.Helpers.current_level rpc_ctxt ~offset:1l ctxt
    >>=? fun l -> return l.voting_period

  let get_voting_period_position ctxt =
    Alpha_services.Helpers.current_level rpc_ctxt ~offset:1l ctxt
    >>=? fun l -> return l.voting_period_position

  let get_current_period_kind ctxt =
    Alpha_services.Voting.current_period_kind rpc_ctxt ctxt

  let get_current_quorum ctxt =
    Alpha_services.Voting.current_quorum rpc_ctxt ctxt

  let get_listings ctxt = Alpha_services.Voting.listings rpc_ctxt ctxt

  let get_proposals ctxt = Alpha_services.Voting.proposals rpc_ctxt ctxt

  let get_current_proposal ctxt =
    Alpha_services.Voting.current_proposal rpc_ctxt ctxt

  let get_protocol (b : Block.t) =
    Tezos_protocol_environment.Context.get b.context ["protocol"]
    >>= function
    | None ->
        assert false
    | Some p ->
        Lwt.return (Protocol_hash.of_bytes_exn p)

  let get_participation_ema (b : Block.t) =
    Environment.Context.get b.context ["votes"; "participation_ema"]
    >>= function
    | None -> assert false | Some bytes -> return (MBytes.get_int32 bytes 0)

  let set_participation_ema (b : Block.t) ema =
    let bytes = Bytes.make 4 '\000' in
    MBytes.set_int32 bytes 0 ema ;
    Environment.Context.set b.context ["votes"; "participation_ema"] bytes
    >>= fun context -> Lwt.return {b with context}
end

module Contract = struct
  let pp = Alpha_context.Contract.pp

  let pkh c =
    Alpha_context.Contract.is_implicit c
    |> function
    | Some p -> return p | None -> failwith "pkh: only for implicit contracts"

  type balance_kind = Main | Deposit | Fees | Rewards

  let balance ?(kind = Main) ctxt contract =
    match kind with
    | Main ->
        Alpha_services.Contract.balance rpc_ctxt ctxt contract
    | _ -> (
      match Alpha_context.Contract.is_implicit contract with
      | None ->
          invalid_arg
            "get_balance: no frozen accounts for an originated contract."
      | Some pkh ->
          Alpha_services.Delegate.frozen_balance_by_cycle rpc_ctxt ctxt pkh
          >>=? fun map ->
          Lwt.return
          @@ Cycle.Map.fold
               (fun _cycle {Delegate.deposit; fees; rewards} acc ->
                 acc
                 >>? fun acc ->
                 match kind with
                 | Deposit ->
                     Test_tez.Tez.(acc +? deposit)
                 | Fees ->
                     Test_tez.Tez.(acc +? fees)
                 | Rewards ->
                     Test_tez.Tez.(acc +? rewards)
                 | _ ->
                     assert false)
               map
               (Ok Tez.zero) )

  let counter ctxt contract =
    match Contract.is_implicit contract with
    | None ->
        invalid_arg "Helpers.Context.counter"
    | Some mgr ->
        Alpha_services.Contract.counter rpc_ctxt ctxt mgr

  let manager _ contract =
    match Contract.is_implicit contract with
    | None ->
        invalid_arg "Helpers.Context.manager"
    | Some pkh ->
        Account.find pkh

  let is_manager_key_revealed ctxt contract =
    match Contract.is_implicit contract with
    | None ->
        invalid_arg "Helpers.Context.is_manager_key_revealed"
    | Some mgr ->
        Alpha_services.Contract.manager_key rpc_ctxt ctxt mgr
        >>=? fun res -> return (res <> None)

  let delegate ctxt contract =
    Alpha_services.Contract.delegate rpc_ctxt ctxt contract

  let delegate_opt ctxt contract =
    Alpha_services.Contract.delegate_opt rpc_ctxt ctxt contract
end

module Delegate = struct
  type info = Delegate_services.info = {
    balance : Tez.t;
    frozen_balance : Tez.t;
    frozen_balance_by_cycle : Delegate.frozen_balance Cycle.Map.t;
    staking_balance : Tez.t;
    delegated_contracts : Contract_repr.t list;
    delegated_balance : Tez.t;
    deactivated : bool;
    grace_period : Cycle.t;
  }

  let info ctxt pkh = Alpha_services.Delegate.info rpc_ctxt ctxt pkh
end

let init ?endorsers_per_block ?with_commitments ?(initial_balances = [])
    ?initial_endorsers ?min_proposal_quorum n =
  let accounts = Account.generate_accounts ~initial_balances n in
  let contracts =
    List.map
      (fun (a, _) -> Alpha_context.Contract.implicit_contract Account.(a.pkh))
      accounts
  in
  Block.genesis
    ?endorsers_per_block
    ?with_commitments
    ?initial_endorsers
    ?min_proposal_quorum
    accounts
  >>=? fun blk -> return (blk, contracts)
context_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Protocol.

Import Alpha_context.

Inductive t : Type :=
| B : Tezos_alpha_test_helpers.Block.t -> t
| I : Tezos_alpha_test_helpers.Incremental.t -> t.

Definition branch (function_parameter : t)
  : Tezos_base__TzPervasives.Block_hash.t :=
  match function_parameter with
  | B b => hash b
  | I i => hash (Incremental.predecessor i)
  end.

Definition level (function_parameter : t)
  : Tezos_protocol_environment_alpha__Environment.Int32.t :=
  match function_parameter with
  | B b => level (shell (header b))
  | I i => Incremental.level i
  end.

Definition get_level (ctxt : t)
  : Lwt.t
    (Tezos_base__TzPervasives.Error_monad.tzresult
      Tezos_protocol_alpha.Protocol.Alpha_context.Raw_level.raw_level) :=
  OCaml.Stdlib.reverse_apply
    (OCaml.Stdlib.reverse_apply
      (OCaml.Stdlib.reverse_apply (level ctxt) Raw_level.of_int32)
      Environment.wrap_error) Lwt.__return.

Definition rpc_ctxt {D F H J a b c i o q : Type}
  : (((Tezos_base__TzPervasives.RPC_service.t variant
    Tezos_protocol_alpha.Protocol.Environment.RPC_context.t
    Tezos_protocol_alpha.Protocol.Environment.RPC_context.t q i o ->
    t -> q -> i -> Lwt.t (Tezos_base__TzPervasives.tzresult o)) *
    (D * q * i * o)) *
    (((Tezos_base__TzPervasives.RPC_service.t variant
      Tezos_protocol_alpha.Protocol.Environment.RPC_context.t
      (Tezos_protocol_alpha.Protocol.Environment.RPC_context.t * a) q i o ->
      t -> a -> q -> i -> Lwt.t (Tezos_base__TzPervasives.tzresult o)) *
      (F * a * q * i * o)) *
      (((Tezos_base__TzPervasives.RPC_service.t variant
        Tezos_protocol_alpha.Protocol.Environment.RPC_context.t
        ((Tezos_protocol_alpha.Protocol.Environment.RPC_context.t * a) * b) q i
        o ->
        t -> a -> b -> q -> i -> Lwt.t (Tezos_base__TzPervasives.tzresult o)) *
        (H * a * b * q * i * o)) *
        (((Tezos_base__TzPervasives.RPC_service.t variant
          Tezos_protocol_alpha.Protocol.Environment.RPC_context.t
          (((Tezos_protocol_alpha.Protocol.Environment.RPC_context.t * a) * b) *
            c) q i o ->
          t ->
            a -> b -> c -> q -> i -> Lwt.t (Tezos_base__TzPervasives.tzresult o))
          * (J * a * b * c * q * i * o)) * nil)))) :=
  (* ❌ Creation of objects is not handled *)
  object.

Definition get_endorsers (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (list
        Tezos_protocol_alpha.Protocol.Alpha_services.Delegate.Endorsing_rights.t)) :=
  Alpha_services.Delegate.Endorsing_rights.get rpc_ctxt None None None ctxt.

Definition get_endorser (ctxt : t)
  : Lwt.t
    (Tezos_base__TzPervasives.tzresult
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
        * list Z)) :=
  op_gtgteqquestion
    (Alpha_services.Delegate.Endorsing_rights.get rpc_ctxt None None None ctxt)
    (fun endorsers =>
      let endorser := List.hd endorsers in
      __return ((delegate endorser), (slots endorser))).

Definition get_bakers (ctxt : t)
  : Lwt.t
    (Tezos_base__TzPervasives.tzresult
      (list
        Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)) :=
  op_gtgteqquestion
    (Alpha_services.Delegate.Baking_rights.get rpc_ctxt None None None None
      (Some 256) ctxt)
    (fun bakers =>
      __return
        (List.map (fun p => Alpha_services.Delegate.Baking_rights.delegate p)
          bakers)).

Definition get_seed_nonce_hash (ctxt : t)
  : Lwt.t
    (Tezos_base__TzPervasives.tzresult Tezos_raw_protocol_alpha.Nonce_hash.t) :=
  let header :=
    match ctxt with
    | B {| header := header |} => header
    | I i => Incremental.header i
    end in
  match seed_nonce_hash (contents (protocol_data header)) with
  | None =>
    failwith
      (CamlinternalFormatBasics.Format
        (CamlinternalFormatBasics.String_literal "No committed nonce" % string
          CamlinternalFormatBasics.End_of_format) "No committed nonce" % string)
  | Some hash => __return hash
  end.

Definition get_seed (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Seed.seed) :=
  Alpha_services.Seed.get rpc_ctxt ctxt.

Definition get_constants (ctxt : t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Constants.t) :=
  Alpha_services.Constants.all rpc_ctxt ctxt.

Definition get_minimal_valid_time
  (ctxt : t) (priority : Z) (endorsing_power : Z)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_protocol_environment_alpha__Environment.Time.t) :=
  Alpha_services.Delegate.Minimal_valid_time.get rpc_ctxt ctxt priority
    endorsing_power.

Definition get_baking_reward (ctxt : t) (priority : Z) (endorsing_power : Z)
  : Lwt.t
    (Tezos_base__TzPervasives.tzresult Tezos_alpha_test_helpers.Test_tez.Tez.tez) :=
  op_gtgteqquestion (get_constants ctxt)
    (fun function_parameter =>
      let '{|
        parametric := {|
          endorsers_per_block := endorsers_per_block;
            block_reward := block_reward
            |}
          |} := function_parameter in
      let prio_factor_denominator := succ (of_int priority) in
      let endo_factor_numerator :=
        Int64.of_int
          (Z.add 8 (Z.div (Z.mul 2 endorsing_power) endorsers_per_block)) in
      let endo_factor_denominator :=
        (* ❌ Constant of type int64 is converted to int *)
        10 in
      Lwt.__return
        (op_gtgtquestion (op_starquestion block_reward endo_factor_numerator)
          (fun val1 =>
            op_gtgtquestion (op_divquestion val1 endo_factor_denominator)
              (fun val2 => op_divquestion val2 prio_factor_denominator)))).

Definition get_endorsing_reward (ctxt : t) (priority : Z) (endorsing_power : Z)
  : Lwt.t
    (Tezos_base__TzPervasives.tzresult Tezos_alpha_test_helpers.Test_tez.Tez.tez) :=
  op_gtgteqquestion (get_constants ctxt)
    (fun function_parameter =>
      let '{| parametric := {| endorsement_reward := endorsement_reward |} |} :=
        function_parameter in
      op_gtgtquestioneq
        (op_divquestion endorsement_reward (succ (of_int priority)))
        (fun reward_per_slot =>
          op_gtgtquestioneq
            (op_starquestion reward_per_slot (Int64.of_int endorsing_power))
            (fun reward => __return reward))).

Module Vote.
  Definition get_ballots (ctxt : t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_raw_protocol_alpha.Alpha_context.Vote.ballots) :=
    Alpha_services.Voting.ballots rpc_ctxt ctxt.
  
  Definition get_ballot_list (ctxt : t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (list
          (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
            * Tezos_raw_protocol_alpha.Alpha_context.Vote.ballot))) :=
    Alpha_services.Voting.ballot_list rpc_ctxt ctxt.
  
  Definition get_voting_period (ctxt : t)
    : Lwt.t
      (Tezos_base__TzPervasives.tzresult
        Tezos_raw_protocol_alpha__Alpha_context.Voting_period.t) :=
    op_gtgteqquestion
      (Alpha_services.Helpers.current_level rpc_ctxt
        (Some
          (* ❌ Constant of type int32 is converted to int *)
          1) ctxt) (fun l => __return (voting_period l)).
  
  Definition get_voting_period_position (ctxt : t)
    : Lwt.t (Tezos_base__TzPervasives.tzresult int32) :=
    op_gtgteqquestion
      (Alpha_services.Helpers.current_level rpc_ctxt
        (Some
          (* ❌ Constant of type int32 is converted to int *)
          1) ctxt) (fun l => __return (voting_period_position l)).
  
  Definition get_current_period_kind (ctxt : t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_raw_protocol_alpha.Alpha_context.Voting_period.kind) :=
    Alpha_services.Voting.current_period_kind rpc_ctxt ctxt.
  
  Definition get_current_quorum (ctxt : t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.Int32.t) :=
    Alpha_services.Voting.current_quorum rpc_ctxt ctxt.
  
  Definition get_listings (ctxt : t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (list
          (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
            * int32))) := Alpha_services.Voting.listings rpc_ctxt ctxt.
  
  Definition get_proposals (ctxt : t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (Tezos_protocol_environment_alpha__Environment.Protocol_hash.Map.t
          Tezos_protocol_environment_alpha__Environment.Int32.t)) :=
    Alpha_services.Voting.proposals rpc_ctxt ctxt.
  
  Definition get_current_proposal (ctxt : t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (option
          Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))) :=
    Alpha_services.Voting.current_proposal rpc_ctxt ctxt.
  
  Definition get_protocol (b : Tezos_alpha_test_helpers.Block.t)
    : Lwt.t Tezos_base__TzPervasives.Protocol_hash.t :=
    op_gtgteq
      (Tezos_protocol_environment.Context.get (context b)
        (cons "protocol" % string []))
      (fun function_parameter =>
        match function_parameter with
        | None =>
          (* ❌ Assert instruction is not handled. *)
          assert false
        | Some p => Lwt.__return (Protocol_hash.of_bytes_exn p)
        end).
  
  Definition get_participation_ema (b : Tezos_alpha_test_helpers.Block.t)
    : Lwt.t (Tezos_base__TzPervasives.tzresult int32) :=
    op_gtgteq
      (Environment.Context.get (context b)
        (cons "votes" % string (cons "participation_ema" % string [])))
      (fun function_parameter =>
        match function_parameter with
        | None =>
          (* ❌ Assert instruction is not handled. *)
          assert false
        | Some bytes => __return (MBytes.get_int32 string 0)
        end).
  
  Definition set_participation_ema
    (b : Tezos_alpha_test_helpers.Block.t) (ema : int32)
    : Lwt.t Tezos_alpha_test_helpers.Block.t :=
    let bytes := Stdlib.Bytes.make 4 "000" % char in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ := MBytes.set_int32 string 0 ema in
    op_gtgteq
      (Environment.Context.set (context b)
        (cons "votes" % string (cons "participation_ema" % string [])) string)
      (fun context =>
        Lwt.__return
          (* ❌ Record substitution not handled *)
          record_substitution).
End Vote.

Module Contract.
  Definition pp
    : Tezos_protocol_environment_alpha__Environment.Format.formatter ->
      Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t -> unit :=
    Alpha_context.Contract.pp.
  
  Definition pkh
    (c : Tezos_protocol_alpha.Protocol.Alpha_context.Contract.contract)
    : Lwt.t
      (Tezos_base__TzPervasives.tzresult
        Tezos_raw_protocol_alpha__Alpha_context.public_key_hash) :=
    OCaml.Stdlib.reverse_apply (Alpha_context.Contract.is_implicit c)
      (fun function_parameter =>
        match function_parameter with
        | Some p => __return p
        | None =>
          failwith
            (CamlinternalFormatBasics.Format
              (CamlinternalFormatBasics.String_literal
                "pkh: only for implicit contracts" % string
                CamlinternalFormatBasics.End_of_format)
              "pkh: only for implicit contracts" % string)
        end).
  
  Inductive balance_kind : Type :=
  | Main : balance_kind
  | Deposit : balance_kind
  | Fees : balance_kind
  | Rewards : balance_kind.
  
  Definition balance (op_staroptstar : option balance_kind)
    : t ->
      Tezos_raw_protocol_alpha.Alpha_context.Contract.t ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            Tezos_raw_protocol_alpha.Alpha_context.Tez.t) :=
    let kind :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => Main
      end in
    fun ctxt =>
      fun contract =>
        match kind with
        | Main => Alpha_services.Contract.balance rpc_ctxt ctxt contract
        | _ =>
          match Alpha_context.Contract.is_implicit contract with
          | None =>
            OCaml.Stdlib.invalid_arg
              "get_balance: no frozen accounts for an originated contract." %
                string
          | Some pkh =>
            op_gtgteqquestion
              (Alpha_services.Delegate.frozen_balance_by_cycle rpc_ctxt ctxt pkh)
              (fun map =>
                apply Lwt.__return
                  (Cycle.Map.fold
                    (fun _cycle =>
                      fun function_parameter =>
                        let '{|
                          Delegate.deposit := deposit;
                            Delegate.fees := fees;
                            Delegate.rewards := rewards
                            |} := function_parameter in
                        fun acc =>
                          op_gtgtquestion acc
                            (fun acc =>
                              match kind with
                              | Deposit => op_plusquestion acc deposit
                              | Fees => op_plusquestion acc fees
                              | Rewards => op_plusquestion acc rewards
                              | _ =>
                                (* ❌ Assert instruction is not handled. *)
                                assert false
                              end)) map (Stdlib.Ok Tez.zero)))
          end
        end.
  
  Definition counter
    (ctxt : t)
    (contract : Tezos_protocol_alpha.Protocol.Alpha_context.Contract.contract)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_raw_protocol_alpha.Alpha_context.counter) :=
    match Contract.is_implicit contract with
    | None => OCaml.Stdlib.invalid_arg "Helpers.Context.counter" % string
    | Some mgr => Alpha_services.Contract.counter rpc_ctxt ctxt mgr
    end.
  
  Definition manager {A : Type} (function_parameter : A)
    : Tezos_protocol_alpha.Protocol.Alpha_context.Contract.contract ->
      Lwt.t
        (Tezos_base__TzPervasives.tzresult Tezos_alpha_test_helpers.Account.t) :=
    let '_ := function_parameter in
    fun contract =>
      match Contract.is_implicit contract with
      | None => OCaml.Stdlib.invalid_arg "Helpers.Context.manager" % string
      | Some pkh => Account.find pkh
      end.
  
  Definition is_manager_key_revealed
    (ctxt : t)
    (contract : Tezos_protocol_alpha.Protocol.Alpha_context.Contract.contract)
    : Lwt.t (Tezos_base__TzPervasives.tzresult bool) :=
    match Contract.is_implicit contract with
    | None =>
      OCaml.Stdlib.invalid_arg
        "Helpers.Context.is_manager_key_revealed" % string
    | Some mgr =>
      op_gtgteqquestion (Alpha_services.Contract.manager_key rpc_ctxt ctxt mgr)
        (fun res => __return (nequiv_decb res None))
    end.
  
  Definition delegate
    (ctxt : t) (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_raw_protocol_alpha.Alpha_context.public_key_hash) :=
    Alpha_services.Contract.delegate rpc_ctxt ctxt contract.
  
  Definition delegate_opt
    (ctxt : t) (contract : Tezos_raw_protocol_alpha.Alpha_context.Contract.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (option Tezos_raw_protocol_alpha.Alpha_context.public_key_hash)) :=
    Alpha_services.Contract.delegate_opt rpc_ctxt ctxt contract.
End Contract.

Module Delegate.
  Record info := {
    balance : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.t;
    frozen_balance : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.t;
    frozen_balance_by_cycle :
      Tezos_protocol_alpha.Protocol.Alpha_context.Cycle.Map.t
        Tezos_protocol_alpha.Protocol.Alpha_context.Delegate.frozen_balance;
    staking_balance : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.t;
    delegated_contracts : list Tezos_protocol_alpha.Protocol.Contract_repr.t;
    delegated_balance : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.t;
    deactivated : bool;
    grace_period : Tezos_protocol_alpha.Protocol.Alpha_context.Cycle.t }.
  
  Definition info
    (ctxt : t)
    (pkh :
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_alpha.Protocol.Alpha_services.Delegate.info) :=
    Alpha_services.Delegate.info rpc_ctxt ctxt pkh.
End Delegate.

Definition init
  (endorsers_per_block : option Z) (with_commitments : option bool)
  (op_staroptstar : option (list int64))
  : option Z ->
    option int32 ->
      Z ->
        Lwt.t
          (Tezos_base__TzPervasives.tzresult
            (Tezos_alpha_test_helpers.Block.block *
              list Tezos_protocol_alpha.Protocol.Alpha_context.Contract.contract)) :=
  let initial_balances :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => []
    end in
  fun initial_endorsers =>
    fun min_proposal_quorum =>
      fun n =>
        let accounts := Account.generate_accounts (Some initial_balances) n in
        let contracts :=
          List.map
            (fun function_parameter =>
              let '(a, _) := function_parameter in
              Alpha_context.Contract.implicit_contract (pkh a)) accounts in
        op_gtgteqquestion
          (Block.genesis with_commitments endorsers_per_block initial_endorsers
            min_proposal_quorum accounts) (fun blk => __return (blk, contracts)).
test/helpers/context.mli success 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol
open Alpha_context
open Environment

type t = B of Block.t | I of Incremental.t

val branch : t -> Block_hash.t

val get_level : t -> Raw_level.t tzresult Lwt.t

val get_endorsers :
  t -> Alpha_services.Delegate.Endorsing_rights.t list tzresult Lwt.t

val get_endorser : t -> (public_key_hash * int list) tzresult Lwt.t

val get_bakers : t -> public_key_hash list tzresult Lwt.t

val get_seed_nonce_hash : t -> Nonce_hash.t tzresult Lwt.t

(** Returns the seed of the cycle to which the block belongs to. *)
val get_seed : t -> Seed.seed tzresult Lwt.t

(** Returns all the constants of the protocol *)
val get_constants : t -> Constants.t tzresult Lwt.t

val get_minimal_valid_time :
  t -> priority:int -> endorsing_power:int -> Time.t tzresult Lwt.t

val get_baking_reward :
  t -> priority:int -> endorsing_power:int -> Tez.t tzresult Lwt.t

val get_endorsing_reward :
  t -> priority:int -> endorsing_power:int -> Tez.t tzresult Lwt.t

module Vote : sig
  val get_ballots : t -> Vote.ballots tzresult Lwt.t

  val get_ballot_list :
    t -> (Signature.Public_key_hash.t * Vote.ballot) list tzresult Lwt.t

  val get_voting_period : t -> Voting_period.t tzresult Lwt.t

  val get_voting_period_position : t -> Int32.t tzresult Lwt.t

  val get_current_period_kind : t -> Voting_period.kind tzresult Lwt.t

  val get_current_quorum : t -> Int32.t tzresult Lwt.t

  val get_participation_ema : Block.t -> Int32.t tzresult Lwt.t

  val get_listings :
    t -> (Signature.Public_key_hash.t * int32) list tzresult Lwt.t

  val get_proposals : t -> Int32.t Protocol_hash.Map.t tzresult Lwt.t

  val get_current_proposal : t -> Protocol_hash.t option tzresult Lwt.t

  val get_protocol : Block.t -> Protocol_hash.t Lwt.t

  val set_participation_ema : Block.t -> int32 -> Block.t Lwt.t
end

module Contract : sig
  val pp : Format.formatter -> Contract.t -> unit

  val pkh : Contract.t -> public_key_hash tzresult Lwt.t

  type balance_kind = Main | Deposit | Fees | Rewards

  (** Returns the balance of a contract, by default the main balance.
      If the contract is implicit the frozen balances are available too:
      deposit, fees or rewards. *)
  val balance : ?kind:balance_kind -> t -> Contract.t -> Tez.t tzresult Lwt.t

  val counter : t -> Contract.t -> Z.t tzresult Lwt.t

  val manager : t -> Contract.t -> Account.t tzresult Lwt.t

  val is_manager_key_revealed : t -> Contract.t -> bool tzresult Lwt.t

  val delegate : t -> Contract.t -> public_key_hash tzresult Lwt.t

  val delegate_opt : t -> Contract.t -> public_key_hash option tzresult Lwt.t
end

module Delegate : sig
  type info = Delegate_services.info = {
    balance : Tez.t;
    frozen_balance : Tez.t;
    frozen_balance_by_cycle : Delegate.frozen_balance Cycle.Map.t;
    staking_balance : Tez.t;
    delegated_contracts : Contract_repr.t list;
    delegated_balance : Tez.t;
    deactivated : bool;
    grace_period : Cycle.t;
  }

  val info : t -> public_key_hash -> Delegate_services.info tzresult Lwt.t
end

(** [init n] : returns an initial block with [n] initialized accounts
    and the associated implicit contracts *)
val init :
  ?endorsers_per_block:int ->
  ?with_commitments:bool ->
  ?initial_balances:int64 list ->
  ?initial_endorsers:int ->
  ?min_proposal_quorum:int32 ->
  int ->
  (Block.t * Alpha_context.Contract.t list) tzresult Lwt.t
context_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Inductive t : Type :=
| B : Tezos_alpha_test_helpers.Block.t -> t
| I : Tezos_alpha_test_helpers.Incremental.t -> t.

Parameter branch : t -> Tezos_protocol_alpha.Protocol.Environment.Block_hash.t.

Parameter get_level :
t ->
  Tezos_protocol_alpha.Protocol.Environment.Lwt.t
    (Tezos_base__TzPervasives.tzresult
      Tezos_protocol_alpha.Protocol.Alpha_context.Raw_level.t).

Parameter get_endorsers :
t ->
  Tezos_protocol_alpha.Protocol.Environment.Lwt.t
    (Tezos_base__TzPervasives.tzresult
      (list
        Tezos_protocol_alpha.Protocol.Alpha_services.Delegate.Endorsing_rights.t)).

Parameter get_endorser :
t ->
  Tezos_protocol_alpha.Protocol.Environment.Lwt.t
    (Tezos_base__TzPervasives.tzresult
      (Tezos_protocol_alpha.Protocol.Alpha_context.public_key_hash * list Z)).

Parameter get_bakers :
t ->
  Tezos_protocol_alpha.Protocol.Environment.Lwt.t
    (Tezos_base__TzPervasives.tzresult
      (list Tezos_protocol_alpha.Protocol.Alpha_context.public_key_hash)).

Parameter get_seed_nonce_hash :
t ->
  Tezos_protocol_alpha.Protocol.Environment.Lwt.t
    (Tezos_base__TzPervasives.tzresult
      Tezos_protocol_alpha.Protocol.Nonce_hash.t).

Parameter get_seed :
t ->
  Tezos_protocol_alpha.Protocol.Environment.Lwt.t
    (Tezos_base__TzPervasives.tzresult
      Tezos_protocol_alpha.Protocol.Alpha_context.Seed.seed).

Parameter get_constants :
t ->
  Tezos_protocol_alpha.Protocol.Environment.Lwt.t
    (Tezos_base__TzPervasives.tzresult
      Tezos_protocol_alpha.Protocol.Alpha_context.Constants.t).

Parameter get_minimal_valid_time :
t ->
  Z ->
    Z ->
      Tezos_protocol_alpha.Protocol.Environment.Lwt.t
        (Tezos_base__TzPervasives.tzresult
          Tezos_protocol_alpha.Protocol.Environment.Time.t).

Parameter get_baking_reward :
t ->
  Z ->
    Z ->
      Tezos_protocol_alpha.Protocol.Environment.Lwt.t
        (Tezos_base__TzPervasives.tzresult
          Tezos_protocol_alpha.Protocol.Alpha_context.Tez.t).

Parameter get_endorsing_reward :
t ->
  Z ->
    Z ->
      Tezos_protocol_alpha.Protocol.Environment.Lwt.t
        (Tezos_base__TzPervasives.tzresult
          Tezos_protocol_alpha.Protocol.Alpha_context.Tez.t).

Module Vote.
  Parameter get_ballots : t ->
    Tezos_protocol_alpha.Protocol.Environment.Lwt.t
      (Tezos_base__TzPervasives.tzresult
        Tezos_protocol_alpha.Protocol.Alpha_context.Vote.ballots).
  
  Parameter get_ballot_list : t ->
    Tezos_protocol_alpha.Protocol.Environment.Lwt.t
      (Tezos_base__TzPervasives.tzresult
        (list
          (Tezos_protocol_alpha.Protocol.Environment.Signature.Public_key_hash.t
            * Tezos_protocol_alpha.Protocol.Alpha_context.Vote.ballot))).
  
  Parameter get_voting_period : t ->
    Tezos_protocol_alpha.Protocol.Environment.Lwt.t
      (Tezos_base__TzPervasives.tzresult
        Tezos_protocol_alpha.Protocol.Alpha_context.Voting_period.t).
  
  Parameter get_voting_period_position : t ->
    Tezos_protocol_alpha.Protocol.Environment.Lwt.t
      (Tezos_base__TzPervasives.tzresult
        Tezos_protocol_alpha.Protocol.Environment.Int32.t).
  
  Parameter get_current_period_kind : t ->
    Tezos_protocol_alpha.Protocol.Environment.Lwt.t
      (Tezos_base__TzPervasives.tzresult
        Tezos_protocol_alpha.Protocol.Alpha_context.Voting_period.kind).
  
  Parameter get_current_quorum : t ->
    Tezos_protocol_alpha.Protocol.Environment.Lwt.t
      (Tezos_base__TzPervasives.tzresult
        Tezos_protocol_alpha.Protocol.Environment.Int32.t).
  
  Parameter get_participation_ema : Tezos_alpha_test_helpers.Block.t ->
    Tezos_protocol_alpha.Protocol.Environment.Lwt.t
      (Tezos_base__TzPervasives.tzresult
        Tezos_protocol_alpha.Protocol.Environment.Int32.t).
  
  Parameter get_listings : t ->
    Tezos_protocol_alpha.Protocol.Environment.Lwt.t
      (Tezos_base__TzPervasives.tzresult
        (list
          (Tezos_protocol_alpha.Protocol.Environment.Signature.Public_key_hash.t
            * int32))).
  
  Parameter get_proposals : t ->
    Tezos_protocol_alpha.Protocol.Environment.Lwt.t
      (Tezos_base__TzPervasives.tzresult
        (Tezos_protocol_alpha.Protocol.Environment.Protocol_hash.Map.t
          Tezos_protocol_alpha.Protocol.Environment.Int32.t)).
  
  Parameter get_current_proposal : t ->
    Tezos_protocol_alpha.Protocol.Environment.Lwt.t
      (Tezos_base__TzPervasives.tzresult
        (option Tezos_protocol_alpha.Protocol.Environment.Protocol_hash.t)).
  
  Parameter get_protocol : Tezos_alpha_test_helpers.Block.t ->
    Tezos_protocol_alpha.Protocol.Environment.Lwt.t
      Tezos_protocol_alpha.Protocol.Environment.Protocol_hash.t.
  
  Parameter set_participation_ema : Tezos_alpha_test_helpers.Block.t ->
    int32 ->
      Tezos_protocol_alpha.Protocol.Environment.Lwt.t
        Tezos_alpha_test_helpers.Block.t.
End Vote.

Module Contract.
  Parameter pp : Tezos_protocol_alpha.Protocol.Environment.Format.formatter ->
    Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t -> unit.
  
  Parameter pkh : Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t ->
    Tezos_protocol_alpha.Protocol.Environment.Lwt.t
      (Tezos_base__TzPervasives.tzresult
        Tezos_protocol_alpha.Protocol.Alpha_context.public_key_hash).
  
  Inductive balance_kind : Type :=
  | Main : balance_kind
  | Deposit : balance_kind
  | Fees : balance_kind
  | Rewards : balance_kind.
  
  Parameter balance : option balance_kind ->
    t ->
      Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t ->
        Tezos_protocol_alpha.Protocol.Environment.Lwt.t
          (Tezos_base__TzPervasives.tzresult
            Tezos_protocol_alpha.Protocol.Alpha_context.Tez.t).
  
  Parameter counter : t ->
    Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t ->
      Tezos_protocol_alpha.Protocol.Environment.Lwt.t
        (Tezos_base__TzPervasives.tzresult
          Tezos_protocol_alpha.Protocol.Environment.Z.t).
  
  Parameter manager : t ->
    Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t ->
      Tezos_protocol_alpha.Protocol.Environment.Lwt.t
        (Tezos_base__TzPervasives.tzresult Tezos_alpha_test_helpers.Account.t).
  
  Parameter is_manager_key_revealed : t ->
    Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t ->
      Tezos_protocol_alpha.Protocol.Environment.Lwt.t
        (Tezos_base__TzPervasives.tzresult bool).
  
  Parameter delegate : t ->
    Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t ->
      Tezos_protocol_alpha.Protocol.Environment.Lwt.t
        (Tezos_base__TzPervasives.tzresult
          Tezos_protocol_alpha.Protocol.Alpha_context.public_key_hash).
  
  Parameter delegate_opt : t ->
    Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t ->
      Tezos_protocol_alpha.Protocol.Environment.Lwt.t
        (Tezos_base__TzPervasives.tzresult
          (option Tezos_protocol_alpha.Protocol.Alpha_context.public_key_hash)).
End Contract.

Module Delegate.
  Record info := {
    balance : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.t;
    frozen_balance : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.t;
    frozen_balance_by_cycle :
      Tezos_protocol_alpha.Protocol.Alpha_context.Cycle.Map.t
        Tezos_protocol_alpha.Protocol.Alpha_context.Delegate.frozen_balance;
    staking_balance : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.t;
    delegated_contracts : list Tezos_protocol_alpha.Protocol.Contract_repr.t;
    delegated_balance : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.t;
    deactivated : bool;
    grace_period : Tezos_protocol_alpha.Protocol.Alpha_context.Cycle.t }.
  
  Parameter info : t ->
    Tezos_protocol_alpha.Protocol.Alpha_context.public_key_hash ->
      Tezos_protocol_alpha.Protocol.Environment.Lwt.t
        (Tezos_base__TzPervasives.tzresult
          Tezos_protocol_alpha.Protocol.Delegate_services.info).
End Delegate.

Parameter init :
option Z ->
  option bool ->
    option (list int64) ->
      option Z ->
        option int32 ->
          Z ->
            Tezos_protocol_alpha.Protocol.Environment.Lwt.t
              (Tezos_base__TzPervasives.tzresult
                (Tezos_alpha_test_helpers.Block.t *
                  list Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t)).
test/helpers/incremental.ml 6 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol
open Alpha_context

type t = {
  predecessor : Block.t;
  state : validation_state;
  rev_operations : Operation.packed list;
  rev_tickets : operation_receipt list;
  header : Block_header.t;
  delegate : Account.t;
}

type incremental = t

let predecessor {predecessor; _} = predecessor

let header {header; _} = header

let rev_tickets {rev_tickets; _} = rev_tickets

let level st = st.header.shell.level

let rpc_context st =
  let result = Alpha_context.finalize st.state.ctxt in
  {
    Environment.Updater.block_hash = Block_hash.zero;
    block_header = {st.header.shell with fitness = result.fitness};
    context = result.context;
  }

let rpc_ctxt =
  new Environment.proto_rpc_context_of_directory rpc_context rpc_services

let begin_construction ?(priority = 0) ?timestamp ?seed_nonce_hash
    ?(policy = Block.By_priority priority) (predecessor : Block.t) =
  Block.get_next_baker ~policy predecessor
  >>=? fun (delegate, priority, _timestamp) ->
  Alpha_services.Delegate.Minimal_valid_time.get
    Block.rpc_ctxt
    predecessor
    priority
    0
  >>=? fun real_timestamp ->
  Account.find delegate
  >>=? fun delegate ->
  let timestamp = Option.unopt ~default:real_timestamp timestamp in
  let contents = Block.Forge.contents ~priority ?seed_nonce_hash () in
  let protocol_data = {Block_header.contents; signature = Signature.zero} in
  let header =
    {
      Block_header.shell =
        {
          predecessor = predecessor.hash;
          proto_level = predecessor.header.shell.proto_level;
          validation_passes = predecessor.header.shell.validation_passes;
          fitness = predecessor.header.shell.fitness;
          timestamp;
          level = predecessor.header.shell.level;
          context = Context_hash.zero;
          operations_hash = Operation_list_list_hash.zero;
        };
      protocol_data = {contents; signature = Signature.zero};
    }
  in
  begin_construction
    ~chain_id:Chain_id.zero
    ~predecessor_context:predecessor.context
    ~predecessor_timestamp:predecessor.header.shell.timestamp
    ~predecessor_fitness:predecessor.header.shell.fitness
    ~predecessor_level:predecessor.header.shell.level
    ~predecessor:predecessor.hash
    ~timestamp
    ~protocol_data
    ()
  >>= fun state ->
  Lwt.return (Environment.wrap_error state)
  >>=? fun state ->
  return
    {
      predecessor;
      state;
      rev_operations = [];
      rev_tickets = [];
      header;
      delegate;
    }

let detect_script_failure :
    type kind. kind Apply_results.operation_metadata -> _ =
  let rec detect_script_failure :
      type kind. kind Apply_results.contents_result_list -> _ =
    let open Apply_results in
    let detect_script_failure_single (type kind)
        (Manager_operation_result
           {operation_result; internal_operation_results; _} :
          kind Kind.manager Apply_results.contents_result) =
      let detect_script_failure (type kind)
          (result : kind manager_operation_result) =
        match result with
        | Applied _ ->
            Ok ()
        | Skipped _ ->
            assert false
        | Backtracked (_, None) ->
            (* there must be another error for this to happen *)
            Ok ()
        | Backtracked (_, Some errs) ->
            Environment.wrap_error (Error errs)
        | Failed (_, errs) ->
            Environment.wrap_error (Error errs)
      in
      List.fold_left
        (fun acc (Internal_operation_result (_, r)) ->
          acc >>? fun () -> detect_script_failure r)
        (detect_script_failure operation_result)
        internal_operation_results
    in
    function
    | Single_result (Manager_operation_result _ as res) ->
        detect_script_failure_single res
    | Single_result _ ->
        Ok ()
    | Cons_result (res, rest) ->
        detect_script_failure_single res
        >>? fun () -> detect_script_failure rest
  in
  fun {contents} -> detect_script_failure contents

let add_operation ?expect_failure st op =
  let open Apply_results in
  apply_operation st.state op
  >>= fun x ->
  Lwt.return (Environment.wrap_error x)
  >>=? function
  | (state, (Operation_metadata result as metadata)) ->
      Lwt.return @@ detect_script_failure result
      >>= fun result ->
      ( match expect_failure with
      | None ->
          Lwt.return result
      | Some f -> (
        match result with
        | Ok _ ->
            failwith "Error expected while adding operation"
        | Error e ->
            f e ) )
      >>=? fun () ->
      return
        {
          st with
          state;
          rev_operations = op :: st.rev_operations;
          rev_tickets = metadata :: st.rev_tickets;
        }
  | (state, (No_operation_metadata as metadata)) ->
      return
        {
          st with
          state;
          rev_operations = op :: st.rev_operations;
          rev_tickets = metadata :: st.rev_tickets;
        }

let finalize_block st =
  finalize_block st.state
  >>= fun x ->
  Lwt.return (Environment.wrap_error x)
  >>=? fun (result, _) ->
  let operations = List.rev st.rev_operations in
  let operations_hash =
    Operation_list_list_hash.compute
      [Operation_list_hash.compute (List.map Operation.hash_packed operations)]
  in
  let header =
    {
      st.header with
      shell =
        {
          st.header.shell with
          level = Int32.succ st.header.shell.level;
          operations_hash;
          fitness = result.fitness;
        };
    }
  in
  let hash = Block_header.hash header in
  return {Block.hash; header; operations; context = result.context}
incremental_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Protocol.

Import Alpha_context.

Record t := {
  predecessor : Tezos_alpha_test_helpers.Block.t;
  state : Tezos_protocol_alpha.Protocol.validation_state;
  rev_operations :
    list Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed;
  rev_tickets : list Tezos_protocol_alpha.Protocol.operation_receipt;
  header : Tezos_protocol_alpha.Protocol.Alpha_context.Block_header.t;
  delegate : Tezos_alpha_test_helpers.Account.t }.

Definition incremental := t.

Definition predecessor (function_parameter : t)
  : Tezos_alpha_test_helpers.Block.t :=
  let '{| predecessor := predecessor |} := function_parameter in
  predecessor.

Definition header (function_parameter : t)
  : Tezos_protocol_alpha.Protocol.Alpha_context.Block_header.t :=
  let '{| header := header |} := function_parameter in
  header.

Definition rev_tickets (function_parameter : t)
  : list Tezos_protocol_alpha.Protocol.operation_receipt :=
  let '{| rev_tickets := rev_tickets |} := function_parameter in
  rev_tickets.

Definition level (st : t)
  : Tezos_protocol_environment_alpha__Environment.Int32.t :=
  level (shell (header st)).

Definition rpc_context (st : t)
  : Tezos_protocol_alpha.Protocol.Environment.Updater.rpc_context :=
  let result := Alpha_context.finalize None (ctxt (state st)) in
  {| Environment.Updater.block_hash := Block_hash.zero;
    Environment.Updater.block_header :=
      (* ❌ Record substitution not handled *)
      record_substitution; Environment.Updater.context := context result |}.

Definition rpc_ctxt
  : Tezos_protocol_alpha.Protocol.Environment.proto_rpc_context_of_directory t :=
  (* ❌ Creation of new objects is not handled *)
  new rpc_context rpc_services.

Definition begin_construction (op_staroptstar : option Z)
  : option Tezos_protocol_environment_alpha__Environment.Time.t ->
    option Tezos_protocol_alpha.Protocol.Nonce_hash.t ->
      option Tezos_alpha_test_helpers.Block.baker_policy ->
        Tezos_alpha_test_helpers.Block.t ->
          Lwt.t (Tezos_base__TzPervasives.tzresult t) :=
  let priority :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => 0
    end in
  fun timestamp =>
    fun seed_nonce_hash =>
      fun op_staroptstar =>
        let policy :=
          match op_staroptstar with
          | Some op_starsthstar => op_starsthstar
          | None => Tezos_alpha_test_helpers.Block.By_priority priority
          end in
        fun predecessor =>
          op_gtgteqquestion (Block.get_next_baker (Some policy) predecessor)
            (fun function_parameter =>
              let '(delegate, priority, _timestamp) := function_parameter in
              op_gtgteqquestion
                (Alpha_services.Delegate.Minimal_valid_time.get Block.rpc_ctxt
                  predecessor priority 0)
                (fun real_timestamp =>
                  op_gtgteqquestion (Account.find delegate)
                    (fun delegate =>
                      let timestamp := Option.unopt real_timestamp timestamp in
                      let contents :=
                        Block.Forge.contents None (Some priority)
                          seed_nonce_hash tt in
                      let protocol_data :=
                        {| Block_header.contents := contents;
                          Block_header.signature := Signature.zero |} in
                      let header :=
                        {|
                          Block_header.shell :=
                            {| level := level (shell (header predecessor));
                              proto_level :=
                                proto_level (shell (header predecessor));
                              predecessor := hash predecessor;
                              timestamp := timestamp;
                              validation_passes :=
                                validation_passes (shell (header predecessor));
                              operations_hash := Operation_list_list_hash.zero;
                              fitness := fitness (shell (header predecessor));
                              context := Context_hash.zero |};
                          Block_header.protocol_data :=
                            {| contents := contents; signature := Signature.zero
                              |} |} in
                      op_gtgteq
                        (begin_construction Chain_id.zero (context predecessor)
                          (timestamp (shell (header predecessor)))
                          (level (shell (header predecessor)))
                          (fitness (shell (header predecessor)))
                          (hash predecessor) timestamp (Some protocol_data) tt)
                        (fun state =>
                          op_gtgteqquestion
                            (Lwt.__return (Environment.wrap_error state))
                            (fun state =>
                              __return
                                {| predecessor := predecessor; state := state;
                                  rev_operations := []; rev_tickets := [];
                                  header := header; delegate := delegate |}))))).

Definition detect_script_failure {kind : Type}
  : Tezos_protocol_alpha.Protocol.Apply_results.operation_metadata kind ->
    Tezos_base__TzPervasives.tzresult unit :=
  let detect_script_failure :=
    let detect_script_failure_single {B : Type}
      (function_parameter :
      Tezos_protocol_alpha.Protocol.Apply_results.contents_result
        (Tezos_protocol_alpha.Protocol.Alpha_context.Kind.manager B))
      : Tezos_base__TzPervasives.tzresult unit :=
      let
        'Tezos_protocol_alpha.Protocol.Apply_results.Manager_operation_result {|
          operation_result := operation_result;
            internal_operation_results := internal_operation_results
            |} := function_parameter in
      let detect_script_failure {C : Type}
        (result :
        Tezos_protocol_alpha.Protocol.Apply_results.manager_operation_result C)
        : sum unit Tezos_base__TzPervasives.Error_monad.trace :=
        match result with
        | Tezos_protocol_alpha.Protocol.Apply_results.Applied _ => Stdlib.Ok tt
        | Tezos_protocol_alpha.Protocol.Apply_results.Skipped _ =>
          (* ❌ Assert instruction is not handled. *)
          assert false
        | Tezos_protocol_alpha.Protocol.Apply_results.Backtracked _ None =>
          Stdlib.Ok tt
        | Tezos_protocol_alpha.Protocol.Apply_results.Backtracked _ (Some errs)
          => Environment.wrap_error (Stdlib.Error errs)
        | Tezos_protocol_alpha.Protocol.Apply_results.Failed _ errs =>
          Environment.wrap_error (Stdlib.Error errs)
        end in
      List.fold_left
        (fun acc =>
          fun function_parameter =>
            let
              'Tezos_protocol_alpha.Protocol.Apply_results.Internal_operation_result
                _ r := function_parameter in
            op_gtgtquestion acc
              (fun function_parameter =>
                let 'tt := function_parameter in
                detect_script_failure r))
        (detect_script_failure operation_result) internal_operation_results in
    fun function_parameter =>
      match function_parameter with
      |
        Tezos_protocol_alpha.Protocol.Apply_results.Single_result
          ((Tezos_protocol_alpha.Protocol.Apply_results.Manager_operation_result
            _) as res) => detect_script_failure_single res
      | Tezos_protocol_alpha.Protocol.Apply_results.Single_result _ =>
        Stdlib.Ok tt
      | Tezos_protocol_alpha.Protocol.Apply_results.Cons_result res rest =>
        op_gtgtquestion (detect_script_failure_single res)
          (fun function_parameter =>
            let 'tt := function_parameter in
            detect_script_failure rest)
      end in
  fun function_parameter =>
    let '{| contents := contents |} := function_parameter in
    detect_script_failure contents.

Definition add_operation
  (expect_failure :
    option
      (Tezos_base__TzPervasives.trace ->
        Lwt.t (Tezos_base__TzPervasives.tzresult unit))) (st : t)
  (op : Tezos_protocol_alpha.Protocol.operation)
  : Lwt.t (Tezos_base__TzPervasives.tzresult t) :=
  op_gtgteq (apply_operation (state st) op)
    (fun x =>
      op_gtgteqquestion (Lwt.__return (Environment.wrap_error x))
        (fun function_parameter =>
          match function_parameter with
          |
            (state,
              (Tezos_protocol_alpha.Protocol.Apply_results.Operation_metadata
                result) as metadata) =>
            op_gtgteq (apply Lwt.__return (detect_script_failure result))
              (fun result =>
                op_gtgteqquestion
                  match expect_failure with
                  | None => Lwt.__return result
                  | Some f =>
                    match result with
                    | Stdlib.Ok _ =>
                      failwith
                        (CamlinternalFormatBasics.Format
                          (CamlinternalFormatBasics.String_literal
                            "Error expected while adding operation" % string
                            CamlinternalFormatBasics.End_of_format)
                          "Error expected while adding operation" % string)
                    | Stdlib.Error e => f e
                    end
                  end
                  (fun function_parameter =>
                    let 'tt := function_parameter in
                    __return
                      (* ❌ Record substitution not handled *)
                      record_substitution))
          |
            (state,
              Tezos_protocol_alpha.Protocol.Apply_results.No_operation_metadata
                as metadata) =>
            __return
              (* ❌ Record substitution not handled *)
              record_substitution
          end)).

Definition finalize_block (st : t)
  : Lwt.t (Tezos_base__TzPervasives.tzresult Tezos_alpha_test_helpers.Block.t) :=
  op_gtgteq (finalize_block (state st))
    (fun x =>
      op_gtgteqquestion (Lwt.__return (Environment.wrap_error x))
        (fun function_parameter =>
          let '(result, _) := function_parameter in
          let operations := List.rev (rev_operations st) in
          let operations_hash :=
            Operation_list_list_hash.compute
              (cons
                (Operation_list_hash.compute
                  (List.map Operation.hash_packed operations)) []) in
          let header :=
            (* ❌ Record substitution not handled *)
            record_substitution in
          let hash := Block_header.hash header in
          __return
            {| Block.hash := hash; Block.header := header;
              Block.operations := operations; Block.context := context result |})).
test/helpers/incremental.mli success 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol
open Alpha_context

type t

type incremental = t

val predecessor : incremental -> Block.t

val header : incremental -> Block_header.t

val rev_tickets : incremental -> operation_receipt list

val level : incremental -> int32

val begin_construction :
  ?priority:int ->
  ?timestamp:Time.Protocol.t ->
  ?seed_nonce_hash:Nonce_hash.t ->
  ?policy:Block.baker_policy ->
  Block.t ->
  incremental tzresult Lwt.t

val add_operation :
  ?expect_failure:(error list -> unit tzresult Lwt.t) ->
  incremental ->
  Operation.packed ->
  incremental tzresult Lwt.t

val finalize_block : incremental -> Block.t tzresult Lwt.t

val rpc_ctxt : incremental Environment.RPC_context.simple
incremental_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter t : Type.

Definition incremental := t.

Parameter predecessor : incremental -> Tezos_alpha_test_helpers.Block.t.

Parameter header :
incremental -> Tezos_protocol_alpha.Protocol.Alpha_context.Block_header.t.

Parameter rev_tickets :
incremental -> list Tezos_protocol_alpha.Protocol.operation_receipt.

Parameter level : incremental -> int32.

Parameter begin_construction :
option Z ->
  option Tezos_base__TzPervasives.Time.Protocol.t ->
    option Tezos_protocol_alpha.Protocol.Nonce_hash.t ->
      option Tezos_alpha_test_helpers.Block.baker_policy ->
        Tezos_alpha_test_helpers.Block.t ->
          Lwt.t (Tezos_base__TzPervasives.tzresult incremental).

Parameter add_operation :
option
  (list Tezos_base__TzPervasives.error ->
    Lwt.t (Tezos_base__TzPervasives.tzresult unit)) ->
  incremental ->
    Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed ->
      Lwt.t (Tezos_base__TzPervasives.tzresult incremental).

Parameter finalize_block :
incremental ->
  Lwt.t (Tezos_base__TzPervasives.tzresult Tezos_alpha_test_helpers.Block.t).

Parameter rpc_ctxt :
Tezos_protocol_alpha.Protocol.Environment.RPC_context.simple incremental.
test/helpers/nonce.ml 3 errors 
(**************************************************************************)
(*                                                                        *)
(*    Copyright (c) 2014 - 2018.                                          *)
(*    Dynamic Ledger Solutions, Inc.< contact@tezos.com >                 *)
(*                                                                        *)
(*    All rights reserved.No warranty, explicit or implicit, provided.    *)
(*                                                                        *)
(**************************************************************************)

open Protocol

module Table = Hashtbl.Make (struct
  type t = Nonce_hash.t

  let hash h = Int32.to_int (MBytes.get_int32 (Nonce_hash.to_bytes h) 0)

  let equal = Nonce_hash.equal
end)

let known_nonces = Table.create 17

let generate () =
  match
    Alpha_context.Nonce.of_bytes
    @@ Rand.generate Alpha_context.Constants.nonce_length
  with
  | Ok nonce ->
      let hash = Alpha_context.Nonce.hash nonce in
      Table.add known_nonces hash nonce ;
      (hash, nonce)
  | Error _ ->
      assert false

let forget_all () = Table.clear known_nonces

let get hash = Table.find known_nonces hash
nonce_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Protocol.

(* ❌ Applications of functors are not handled. *)
functor_application

Definition known_nonces
  : Table.t Tezos_protocol_alpha.Protocol.Alpha_context.Nonce.nonce :=
  Table.create 17.

Definition generate (function_parameter : unit)
  : Tezos_raw_protocol_alpha.Nonce_hash.t *
    Tezos_protocol_alpha.Protocol.Alpha_context.Nonce.nonce :=
  let 'tt := function_parameter in
  match
    apply Alpha_context.Nonce.of_bytes
      (Rand.generate Alpha_context.Constants.nonce_length) with
  | Stdlib.Ok nonce =>
    let hash := Alpha_context.Nonce.hash nonce in
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ := Table.add known_nonces hash nonce in
    (hash, nonce)
  | Stdlib.Error _ =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  end.

Definition forget_all (function_parameter : unit) : unit :=
  let 'tt := function_parameter in
  Table.clear known_nonces.

Definition get (hash : Table.key)
  : Tezos_protocol_alpha.Protocol.Alpha_context.Nonce.nonce :=
  Table.find known_nonces hash.
test/helpers/nonce.mli success 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol

(** Returns a fresh nonce and its corresponding hash (and stores them). *)
val generate : unit -> Nonce_hash.t * Alpha_context.Nonce.t

val get : Nonce_hash.t -> Alpha_context.Nonce.t

val forget_all : unit -> unit
nonce_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter generate :
unit ->
  Tezos_protocol_alpha.Protocol.Nonce_hash.t *
    Tezos_protocol_alpha.Protocol.Alpha_context.Nonce.t.

Parameter get :
Tezos_protocol_alpha.Protocol.Nonce_hash.t ->
  Tezos_protocol_alpha.Protocol.Alpha_context.Nonce.t.

Parameter forget_all : unit -> unit.
test/helpers/op.ml 7 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol
open Alpha_context

let sign ?(watermark = Signature.Generic_operation) sk ctxt contents =
  let branch = Context.branch ctxt in
  let unsigned =
    Data_encoding.Binary.to_bytes_exn
      Operation.unsigned_encoding
      ({branch}, Contents_list contents)
  in
  let signature = Some (Signature.sign ~watermark sk unsigned) in
  ({shell = {branch}; protocol_data = {contents; signature}} : _ Operation.t)

let endorsement ?delegate ?level ctxt ?(signing_context = ctxt) () =
  ( match delegate with
  | None ->
      Context.get_endorser ctxt >>=? fun (delegate, _slots) -> return delegate
  | Some delegate ->
      return delegate )
  >>=? fun delegate_pkh ->
  Account.find delegate_pkh
  >>=? fun delegate ->
  ( match level with
  | None ->
      Context.get_level ctxt
  | Some level ->
      return level )
  >>=? fun level ->
  let op = Single (Endorsement {level}) in
  return
    (sign
       ~watermark:Signature.(Endorsement Chain_id.zero)
       delegate.sk
       signing_context
       op)

let sign ?watermark sk ctxt (Contents_list contents) =
  Operation.pack (sign ?watermark sk ctxt contents)

let combine_operations ?public_key ?counter ~source ctxt
    (packed_operations : packed_operation list) =
  assert (List.length packed_operations > 0) ;
  (* Hypothesis : each operation must have the same branch (is this really true?) *)
  let {Tezos_base.Operation.branch} = (List.hd packed_operations).shell in
  assert (
    List.for_all
      (fun {shell = {Tezos_base.Operation.branch = b; _}; _} ->
        Block_hash.(branch = b))
      packed_operations ) ;
  (* TODO? : check signatures consistency *)
  let unpacked_operations =
    List.map
      (function
        | {Alpha_context.protocol_data = Operation_data {contents; _}; _} -> (
          match Contents_list contents with
          | Contents_list (Single o) ->
              Contents o
          | Contents_list
              (Cons (Manager_operation {operation = Reveal _; _}, Single o)) ->
              Contents o
          | _ ->
              (* TODO : decent error *) assert false ))
      packed_operations
  in
  ( match counter with
  | Some counter ->
      return counter
  | None ->
      Context.Contract.counter ctxt source )
  >>=? fun counter ->
  (* We increment the counter *)
  let counter = Z.succ counter in
  Context.Contract.manager ctxt source
  >>=? fun account ->
  let public_key = Option.unopt ~default:account.pk public_key in
  Context.Contract.is_manager_key_revealed ctxt source
  >>=? (function
         | false ->
             let reveal_op =
               Manager_operation
                 {
                   source = Signature.Public_key.hash public_key;
                   fee = Tez.zero;
                   counter;
                   operation = Reveal public_key;
                   gas_limit = Z.of_int 10000;
                   storage_limit = Z.zero;
                 }
             in
             return (Some (Contents reveal_op), Z.succ counter)
         | true ->
             return (None, counter))
  >>=? fun (manager_op, counter) ->
  (* Update counters and transform into a contents_list *)
  let operations =
    List.fold_left
      (fun (counter, acc) -> function Contents (Manager_operation m) ->
            ( Z.succ counter,
              Contents (Manager_operation {m with counter}) :: acc ) | x ->
            (counter, x :: acc))
      (counter, match manager_op with None -> [] | Some op -> [op])
      unpacked_operations
    |> snd |> List.rev
  in
  let operations = Operation.of_list operations in
  return @@ sign account.sk ctxt operations

let manager_operation ?counter ?(fee = Tez.zero) ?gas_limit ?storage_limit
    ?public_key ~source ctxt operation =
  ( match counter with
  | Some counter ->
      return counter
  | None ->
      Context.Contract.counter ctxt source )
  >>=? fun counter ->
  Context.get_constants ctxt
  >>=? fun c ->
  let gas_limit =
    Option.unopt
      ~default:c.parametric.hard_storage_limit_per_operation
      gas_limit
  in
  let storage_limit =
    Option.unopt
      ~default:c.parametric.hard_storage_limit_per_operation
      storage_limit
  in
  Context.Contract.manager ctxt source
  >>=? fun account ->
  let public_key = Option.unopt ~default:account.pk public_key in
  let counter = Z.succ counter in
  Context.Contract.is_manager_key_revealed ctxt source
  >>=? function
  | true ->
      let op =
        Manager_operation
          {
            source = Signature.Public_key.hash public_key;
            fee;
            counter;
            operation;
            gas_limit;
            storage_limit;
          }
      in
      return (Contents_list (Single op))
  | false ->
      let op_reveal =
        Manager_operation
          {
            source = Signature.Public_key.hash public_key;
            fee = Tez.zero;
            counter;
            operation = Reveal public_key;
            gas_limit = Z.of_int 10000;
            storage_limit = Z.zero;
          }
      in
      let op =
        Manager_operation
          {
            source = Signature.Public_key.hash public_key;
            fee;
            counter = Z.succ counter;
            operation;
            gas_limit;
            storage_limit;
          }
      in
      return (Contents_list (Cons (op_reveal, Single op)))

let revelation ctxt public_key =
  let pkh = Signature.Public_key.hash public_key in
  let source = Contract.implicit_contract pkh in
  Context.Contract.counter ctxt source
  >>=? fun counter ->
  Context.Contract.manager ctxt source
  >>=? fun account ->
  let counter = Z.succ counter in
  let sop =
    Contents_list
      (Single
         (Manager_operation
            {
              source = Signature.Public_key.hash public_key;
              fee = Tez.zero;
              counter;
              operation = Reveal public_key;
              gas_limit = Z.of_int 10000;
              storage_limit = Z.zero;
            }))
  in
  return @@ sign account.sk ctxt sop

let originated_contract op =
  let nonce = Contract.initial_origination_nonce (Operation.hash_packed op) in
  Contract.originated_contract nonce

exception Impossible

let origination ?counter ?delegate ~script ?(preorigination = None) ?public_key
    ?credit ?fee ?gas_limit ?storage_limit ctxt source =
  Context.Contract.manager ctxt source
  >>=? fun account ->
  let default_credit = Tez.of_mutez @@ Int64.of_int 1000001 in
  let default_credit = Option.unopt_exn Impossible default_credit in
  let credit = Option.unopt ~default:default_credit credit in
  let operation = Origination {delegate; script; credit; preorigination} in
  manager_operation
    ?counter
    ?public_key
    ?fee
    ?gas_limit
    ?storage_limit
    ~source
    ctxt
    operation
  >>=? fun sop ->
  let op = sign account.sk ctxt sop in
  return (op, originated_contract op)

let miss_signed_endorsement ?level ctxt =
  ( match level with
  | None ->
      Context.get_level ctxt
  | Some level ->
      return level )
  >>=? fun level ->
  Context.get_endorser ctxt
  >>=? fun (real_delegate_pkh, _slots) ->
  let delegate = Account.find_alternate real_delegate_pkh in
  endorsement ~delegate:delegate.pkh ~level ctxt ()

let transaction ?fee ?gas_limit ?storage_limit
    ?(parameters = Script.unit_parameter) ?(entrypoint = "default") ctxt
    (src : Contract.t) (dst : Contract.t) (amount : Tez.t) =
  let top = Transaction {amount; parameters; destination = dst; entrypoint} in
  manager_operation ?fee ?gas_limit ?storage_limit ~source:src ctxt top
  >>=? fun sop ->
  Context.Contract.manager ctxt src
  >>=? fun account -> return @@ sign account.sk ctxt sop

let delegation ?fee ctxt source dst =
  let top = Delegation dst in
  manager_operation ?fee ~source ctxt top
  >>=? fun sop ->
  Context.Contract.manager ctxt source
  >>=? fun account -> return @@ sign account.sk ctxt sop

let activation ctxt (pkh : Signature.Public_key_hash.t) activation_code =
  ( match pkh with
  | Ed25519 edpkh ->
      return edpkh
  | _ ->
      failwith
        "Wrong public key hash : %a - Commitments must be activated with an \
         Ed25519 encrypted public key hash"
        Signature.Public_key_hash.pp
        pkh )
  >>=? fun id ->
  let contents = Single (Activate_account {id; activation_code}) in
  let branch = Context.branch ctxt in
  return
    {
      shell = {branch};
      protocol_data = Operation_data {contents; signature = None};
    }

let double_endorsement ctxt op1 op2 =
  let contents = Single (Double_endorsement_evidence {op1; op2}) in
  let branch = Context.branch ctxt in
  return
    {
      shell = {branch};
      protocol_data = Operation_data {contents; signature = None};
    }

let double_baking ctxt bh1 bh2 =
  let contents = Single (Double_baking_evidence {bh1; bh2}) in
  let branch = Context.branch ctxt in
  return
    {
      shell = {branch};
      protocol_data = Operation_data {contents; signature = None};
    }

let seed_nonce_revelation ctxt level nonce =
  return
    {
      shell = {branch = Context.branch ctxt};
      protocol_data =
        Operation_data
          {
            contents = Single (Seed_nonce_revelation {level; nonce});
            signature = None;
          };
    }

let proposals ctxt (pkh : Contract.t) proposals =
  Context.Contract.pkh pkh
  >>=? fun source ->
  Context.Vote.get_voting_period ctxt
  >>=? fun period ->
  let op = Proposals {source; period; proposals} in
  Account.find source
  >>=? fun account -> return (sign account.sk ctxt (Contents_list (Single op)))

let ballot ctxt (pkh : Contract.t) proposal ballot =
  Context.Contract.pkh pkh
  >>=? fun source ->
  Context.Vote.get_voting_period ctxt
  >>=? fun period ->
  let op = Ballot {source; period; proposal; ballot} in
  Account.find source
  >>=? fun account -> return (sign account.sk ctxt (Contents_list (Single op)))

let dummy_script =
  let open Micheline in
  Script.
    {
      code =
        lazy_expr
          (strip_locations
             (Seq
                ( 0,
                  [ Prim (0, K_parameter, [Prim (0, T_unit, [], [])], []);
                    Prim (0, K_storage, [Prim (0, T_unit, [], [])], []);
                    Prim
                      ( 0,
                        K_code,
                        [ Seq
                            ( 0,
                              [ Prim (0, I_CDR, [], []);
                                Prim
                                  ( 0,
                                    I_NIL,
                                    [Prim (0, T_operation, [], [])],
                                    [] );
                                Prim (0, I_PAIR, [], []) ] ) ],
                        [] ) ] )));
      storage = lazy_expr (strip_locations (Prim (0, D_Unit, [], [])));
    }

let dummy_script_cost = Test_tez.Tez.of_mutez_exn 38_000L
op_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Protocol.

Import Alpha_context.

Definition sign {A : Type}
  (op_staroptstar : option Tezos_base__TzPervasives.Signature.watermark)
  : Tezos_base__TzPervasives.Signature.Secret_key.t ->
    Tezos_alpha_test_helpers.Context.t ->
      Tezos_protocol_alpha.Protocol.Alpha_context.contents_list A ->
        Tezos_protocol_alpha.Protocol.Alpha_context.Operation.t A :=
  let watermark :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => Tezos_base__TzPervasives.Signature.Generic_operation
    end in
  fun sk =>
    fun ctxt =>
      fun contents =>
        let branch := Context.branch ctxt in
        let unsigned :=
          Data_encoding.Binary.to_bytes_exn Operation.unsigned_encoding
            ({| branch := branch |},
              (Tezos_protocol_alpha.Protocol.Alpha_context.Contents_list
                contents)) in
        let signature := Some (Signature.sign (Some watermark) sk unsigned) in
        {| shell := {| branch := branch |};
          protocol_data := {| contents := contents; signature := signature |} |}.

Definition endorsement
  (delegate : option Tezos_protocol_alpha.Protocol.Alpha_context.public_key_hash)
  (level : option Tezos_protocol_alpha.Protocol.Alpha_context.Raw_level.t)
  (ctxt : Tezos_alpha_test_helpers.Context.t)
  (op_staroptstar : option Tezos_alpha_test_helpers.Context.t)
  : unit ->
    Lwt.t
      (Tezos_base__TzPervasives.tzresult
        (Tezos_protocol_alpha.Protocol.Alpha_context.Operation.t
          Tezos_protocol_alpha.Protocol.Alpha_context.Kind.endorsement)) :=
  let signing_context :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => ctxt
    end in
  fun function_parameter =>
    let 'tt := function_parameter in
    op_gtgteqquestion
      match delegate with
      | None =>
        op_gtgteqquestion (Context.get_endorser ctxt)
          (fun function_parameter =>
            let '(delegate, _slots) := function_parameter in
            __return delegate)
      | Some delegate => __return delegate
      end
      (fun delegate_pkh =>
        op_gtgteqquestion (Account.find delegate_pkh)
          (fun delegate =>
            op_gtgteqquestion
              match level with
              | None => Context.get_level ctxt
              | Some level => __return level
              end
              (fun level =>
                let op :=
                  Tezos_protocol_alpha.Protocol.Alpha_context.Single
                    (Tezos_protocol_alpha.Protocol.Alpha_context.Endorsement
                      {| level := level |}) in
                __return
                  (sign
                    (Some
                      (Tezos_base__TzPervasives.Signature.Endorsement
                        Chain_id.zero)) (sk delegate) signing_context op)))).

Definition sign
  (watermark : option Tezos_base__TzPervasives.Signature.watermark)
  (sk : Tezos_base__TzPervasives.Signature.Secret_key.t)
  (ctxt : Tezos_alpha_test_helpers.Context.t)
  (function_parameter :
    Tezos_protocol_alpha.Protocol.Alpha_context.packed_contents_list)
  : Tezos_raw_protocol_alpha__Alpha_context.packed_operation :=
  let 'Tezos_protocol_alpha.Protocol.Alpha_context.Contents_list contents :=
    function_parameter in
  Operation.pack (sign watermark sk ctxt contents).

Definition combine_operations
  (public_key : option Tezos_base__TzPervasives.Signature.Public_key.t)
  (counter : option Tezos_protocol_alpha.Protocol.Environment.Z.t)
  (source : Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t)
  (ctxt : Tezos_alpha_test_helpers.Context.t)
  (packed_operations :
    list Tezos_protocol_alpha.Protocol.Alpha_context.packed_operation)
  : Lwt.t
    (Tezos_base__TzPervasives.tzresult
      Tezos_raw_protocol_alpha__Alpha_context.packed_operation) :=
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    (* ❌ Assert instruction is not handled. *)
    assert (OCaml.Stdlib.gt (List.length packed_operations) 0) in
  let '{| Tezos_base.Operation.branch := branch |} :=
    shell (List.hd packed_operations) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    (* ❌ Assert instruction is not handled. *)
    assert
      (List.for_all
        (fun function_parameter =>
          let '{| shell := {| Tezos_base.Operation.branch := b |} |} :=
            function_parameter in
          op_eq branch b) packed_operations) in
  let unpacked_operations :=
    List.map
      (fun function_parameter =>
        let '{|
          Alpha_context.protocol_data :=
            Tezos_protocol_alpha.Protocol.Alpha_context.Operation_data {|
              contents := contents |}
            |} := function_parameter in
        match Tezos_protocol_alpha.Protocol.Alpha_context.Contents_list contents
          with
        |
          Tezos_protocol_alpha.Protocol.Alpha_context.Contents_list
            (Tezos_protocol_alpha.Protocol.Alpha_context.Single o) =>
          Tezos_protocol_alpha.Protocol.Alpha_context.Contents o
        |
          Tezos_protocol_alpha.Protocol.Alpha_context.Contents_list
            (Tezos_protocol_alpha.Protocol.Alpha_context.Cons
              (Tezos_protocol_alpha.Protocol.Alpha_context.Manager_operation {|
                operation := Tezos_protocol_alpha.Protocol.Alpha_context.Reveal _
                  |}) (Tezos_protocol_alpha.Protocol.Alpha_context.Single o)) =>
          Tezos_protocol_alpha.Protocol.Alpha_context.Contents o
        | _ =>
          (* ❌ Assert instruction is not handled. *)
          assert false
        end) packed_operations in
  op_gtgteqquestion
    match counter with
    | Some counter => __return counter
    | None => Context.Contract.counter ctxt source
    end
    (fun counter =>
      let counter := Z.succ counter in
      op_gtgteqquestion (Context.Contract.manager ctxt source)
        (fun account =>
          let public_key := Option.unopt (pk account) public_key in
          op_gtgteqquestion
            (op_gtgteqquestion
              (Context.Contract.is_manager_key_revealed ctxt source)
              (fun function_parameter =>
                match function_parameter with
                | false =>
                  let reveal_op :=
                    Tezos_protocol_alpha.Protocol.Alpha_context.Manager_operation
                      {| source := Signature.Public_key.hash public_key;
                        fee := Tez.zero; counter := counter;
                        operation :=
                          Tezos_protocol_alpha.Protocol.Alpha_context.Reveal
                            public_key; gas_limit := Z.of_int 10000;
                        storage_limit := Z.zero |} in
                  __return
                    ((Some
                      (Tezos_protocol_alpha.Protocol.Alpha_context.Contents
                        reveal_op)), (Z.succ counter))
                | true => __return (None, counter)
                end))
            (fun function_parameter =>
              let '(manager_op, counter) := function_parameter in
              let operations :=
                OCaml.Stdlib.reverse_apply
                  (OCaml.Stdlib.reverse_apply
                    (List.fold_left
                      (fun function_parameter =>
                        let '(counter, acc) := function_parameter in
                        fun function_parameter =>
                          match function_parameter with
                          |
                            Tezos_protocol_alpha.Protocol.Alpha_context.Contents
                              (Tezos_protocol_alpha.Protocol.Alpha_context.Manager_operation
                                m) =>
                            ((Z.succ counter),
                              (cons
                                (Tezos_protocol_alpha.Protocol.Alpha_context.Contents
                                  (Tezos_protocol_alpha.Protocol.Alpha_context.Manager_operation
                                    (* ❌ Record substitution not handled *)
                                    record_substitution)) acc))
                          | x => (counter, (cons x acc))
                          end)
                      (counter,
                        match manager_op with
                        | None => []
                        | Some op => cons op []
                        end) unpacked_operations) snd) List.rev in
              let operations := Operation.of_list operations in
              apply __return (sign None (sk account) ctxt operations)))).

Definition manager_operation {A : Type}
  (counter : option Tezos_protocol_alpha.Protocol.Environment.Z.t)
  (op_staroptstar : option Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez)
  : option Tezos_protocol_environment_alpha__Environment.Z.t ->
    option Tezos_protocol_environment_alpha__Environment.Z.t ->
      option Tezos_base__TzPervasives.Signature.Public_key.t ->
        Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t ->
          Tezos_alpha_test_helpers.Context.t ->
            Tezos_protocol_alpha.Protocol.Alpha_context.manager_operation A ->
              Lwt.t
                (Tezos_base__TzPervasives.tzresult
                  Tezos_protocol_alpha.Protocol.Alpha_context.packed_contents_list) :=
  let fee :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => Tez.zero
    end in
  fun gas_limit =>
    fun storage_limit =>
      fun public_key =>
        fun source =>
          fun ctxt =>
            fun operation =>
              op_gtgteqquestion
                match counter with
                | Some counter => __return counter
                | None => Context.Contract.counter ctxt source
                end
                (fun counter =>
                  op_gtgteqquestion (Context.get_constants ctxt)
                    (fun c =>
                      let gas_limit :=
                        Option.unopt
                          (hard_storage_limit_per_operation (parametric c))
                          gas_limit in
                      let storage_limit :=
                        Option.unopt
                          (hard_storage_limit_per_operation (parametric c))
                          storage_limit in
                      op_gtgteqquestion (Context.Contract.manager ctxt source)
                        (fun account =>
                          let public_key := Option.unopt (pk account) public_key
                            in
                          let counter := Z.succ counter in
                          op_gtgteqquestion
                            (Context.Contract.is_manager_key_revealed ctxt
                              source)
                            (fun function_parameter =>
                              match function_parameter with
                              | true =>
                                let op :=
                                  Tezos_protocol_alpha.Protocol.Alpha_context.Manager_operation
                                    {|
                                      source :=
                                        Signature.Public_key.hash public_key;
                                      fee := fee; counter := counter;
                                      operation := operation;
                                      gas_limit := gas_limit;
                                      storage_limit := storage_limit |} in
                                __return
                                  (Tezos_protocol_alpha.Protocol.Alpha_context.Contents_list
                                    (Tezos_protocol_alpha.Protocol.Alpha_context.Single
                                      op))
                              | false =>
                                let op_reveal :=
                                  Tezos_protocol_alpha.Protocol.Alpha_context.Manager_operation
                                    {|
                                      source :=
                                        Signature.Public_key.hash public_key;
                                      fee := Tez.zero; counter := counter;
                                      operation :=
                                        Tezos_protocol_alpha.Protocol.Alpha_context.Reveal
                                          public_key;
                                      gas_limit := Z.of_int 10000;
                                      storage_limit := Z.zero |} in
                                let op :=
                                  Tezos_protocol_alpha.Protocol.Alpha_context.Manager_operation
                                    {|
                                      source :=
                                        Signature.Public_key.hash public_key;
                                      fee := fee; counter := Z.succ counter;
                                      operation := operation;
                                      gas_limit := gas_limit;
                                      storage_limit := storage_limit |} in
                                __return
                                  (Tezos_protocol_alpha.Protocol.Alpha_context.Contents_list
                                    (Tezos_protocol_alpha.Protocol.Alpha_context.Cons
                                      op_reveal
                                      (Tezos_protocol_alpha.Protocol.Alpha_context.Single
                                        op)))
                              end)))).

Definition revelation
  (ctxt : Tezos_alpha_test_helpers.Context.t)
  (public_key : Tezos_base__TzPervasives.Signature.Public_key.t)
  : Lwt.t
    (Tezos_base__TzPervasives.tzresult
      Tezos_raw_protocol_alpha__Alpha_context.packed_operation) :=
  let pkh := Signature.Public_key.hash public_key in
  let source := Contract.implicit_contract pkh in
  op_gtgteqquestion (Context.Contract.counter ctxt source)
    (fun counter =>
      op_gtgteqquestion (Context.Contract.manager ctxt source)
        (fun account =>
          let counter := Z.succ counter in
          let sop :=
            Tezos_protocol_alpha.Protocol.Alpha_context.Contents_list
              (Tezos_protocol_alpha.Protocol.Alpha_context.Single
                (Tezos_protocol_alpha.Protocol.Alpha_context.Manager_operation
                  {| source := Signature.Public_key.hash public_key;
                    fee := Tez.zero; counter := counter;
                    operation :=
                      Tezos_protocol_alpha.Protocol.Alpha_context.Reveal
                        public_key; gas_limit := Z.of_int 10000;
                    storage_limit := Z.zero |})) in
          apply __return (sign None (sk account) ctxt sop))).

Definition originated_contract
  (op : Tezos_raw_protocol_alpha__Alpha_context.packed_operation)
  : Tezos_protocol_alpha.Protocol.Alpha_context.Contract.contract :=
  let nonce := Contract.initial_origination_nonce (Operation.hash_packed op) in
  Contract.originated_contract nonce.

(* ❌ The definition of exceptions is not handled. *)
exception

Definition origination
  (counter : option Tezos_protocol_alpha.Protocol.Environment.Z.t)
  (delegate :
    option
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  (script : Tezos_protocol_alpha.Protocol.Alpha_context.Script.t)
  (op_staroptstar :
    option (option Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t))
  : option Tezos_base__TzPervasives.Signature.Public_key.t ->
    option Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez ->
      option Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez ->
        option Tezos_protocol_environment_alpha__Environment.Z.t ->
          option Tezos_protocol_environment_alpha__Environment.Z.t ->
            Tezos_alpha_test_helpers.Context.t ->
              Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t ->
                Lwt.t
                  (Tezos_base__TzPervasives.tzresult
                    (Tezos_raw_protocol_alpha__Alpha_context.packed_operation *
                      Tezos_protocol_alpha.Protocol.Alpha_context.Contract.contract)) :=
  let preorigination :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => None
    end in
  fun public_key =>
    fun credit =>
      fun fee =>
        fun gas_limit =>
          fun storage_limit =>
            fun ctxt =>
              fun source =>
                op_gtgteqquestion (Context.Contract.manager ctxt source)
                  (fun account =>
                    let default_credit :=
                      apply Tez.of_mutez (Int64.of_int 1000001) in
                    let default_credit :=
                      Option.unopt_exn Impossible default_credit in
                    let credit := Option.unopt default_credit credit in
                    let operation :=
                      Tezos_protocol_alpha.Protocol.Alpha_context.Origination
                        {| delegate := delegate; script := script;
                          credit := credit; preorigination := preorigination |}
                      in
                    op_gtgteqquestion
                      (manager_operation counter fee gas_limit storage_limit
                        public_key source ctxt operation)
                      (fun sop =>
                        let op := sign None (sk account) ctxt sop in
                        __return (op, (originated_contract op)))).

Definition miss_signed_endorsement
  (level : option Tezos_protocol_alpha.Protocol.Alpha_context.Raw_level.t)
  (ctxt : Tezos_alpha_test_helpers.Context.t)
  : Lwt.t
    (Tezos_base__TzPervasives.tzresult
      (Tezos_protocol_alpha.Protocol.Alpha_context.Operation.t
        Tezos_protocol_alpha.Protocol.Alpha_context.Kind.endorsement)) :=
  op_gtgteqquestion
    match level with
    | None => Context.get_level ctxt
    | Some level => __return level
    end
    (fun level =>
      op_gtgteqquestion (Context.get_endorser ctxt)
        (fun function_parameter =>
          let '(real_delegate_pkh, _slots) := function_parameter in
          let delegate := Account.find_alternate real_delegate_pkh in
          endorsement (Some (pkh delegate)) (Some level) ctxt None tt)).

Definition transaction
  (fee : option Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez)
  (gas_limit : option Tezos_protocol_environment_alpha__Environment.Z.t)
  (storage_limit : option Tezos_protocol_environment_alpha__Environment.Z.t)
  (op_staroptstar :
    option Tezos_protocol_alpha.Protocol.Alpha_context.Script.lazy_expr)
  : option string ->
    Tezos_alpha_test_helpers.Context.t ->
      Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t ->
        Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t ->
          Tezos_protocol_alpha.Protocol.Alpha_context.Tez.t ->
            Lwt.t
              (Tezos_base__TzPervasives.tzresult
                Tezos_raw_protocol_alpha__Alpha_context.packed_operation) :=
  let parameters :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => Script.unit_parameter
    end in
  fun op_staroptstar =>
    let entrypoint :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => "default" % string
      end in
    fun ctxt =>
      fun src =>
        fun dst =>
          fun amount =>
            let top :=
              Tezos_protocol_alpha.Protocol.Alpha_context.Transaction
                {| amount := amount; parameters := parameters;
                  entrypoint := entrypoint; destination := dst |} in
            op_gtgteqquestion
              (manager_operation None fee gas_limit storage_limit None src ctxt
                top)
              (fun sop =>
                op_gtgteqquestion (Context.Contract.manager ctxt src)
                  (fun account =>
                    apply __return (sign None (sk account) ctxt sop))).

Definition delegation
  (fee : option Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez)
  (ctxt : Tezos_alpha_test_helpers.Context.t)
  (source : Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t)
  (dst :
    option
      Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t)
  : Lwt.t
    (Tezos_base__TzPervasives.tzresult
      Tezos_raw_protocol_alpha__Alpha_context.packed_operation) :=
  let top := Tezos_protocol_alpha.Protocol.Alpha_context.Delegation dst in
  op_gtgteqquestion (manager_operation None fee None None None source ctxt top)
    (fun sop =>
      op_gtgteqquestion (Context.Contract.manager ctxt source)
        (fun account => apply __return (sign None (sk account) ctxt sop))).

Definition activation
  (ctxt : Tezos_alpha_test_helpers.Context.t)
  (pkh : Tezos_base__TzPervasives.Signature.Public_key_hash.t)
  (activation_code :
    Tezos_raw_protocol_alpha.Blinded_public_key_hash.activation_code)
  : Lwt.t
    (Tezos_base__TzPervasives.tzresult
      Tezos_protocol_alpha.Protocol.Alpha_context.packed_operation) :=
  op_gtgteqquestion
    match pkh with
    | Tezos_crypto__Signature.Ed25519 edpkh => __return edpkh
    | _ =>
      failwith
        (CamlinternalFormatBasics.Format
          (CamlinternalFormatBasics.String_literal
            "Wrong public key hash : " % string
            (CamlinternalFormatBasics.Alpha
              (CamlinternalFormatBasics.String_literal
                " - Commitments must be activated with an Ed25519 encrypted public key hash"
                  % string CamlinternalFormatBasics.End_of_format)))
          "Wrong public key hash : %a - Commitments must be activated with an Ed25519 encrypted public key hash"
            % string) Signature.Public_key_hash.pp pkh
    end
    (fun id =>
      let contents :=
        Tezos_protocol_alpha.Protocol.Alpha_context.Single
          (Tezos_protocol_alpha.Protocol.Alpha_context.Activate_account
            {| id := id; activation_code := activation_code |}) in
      let branch := Context.branch ctxt in
      __return
        {| shell := {| branch := branch |};
          protocol_data :=
            Tezos_protocol_alpha.Protocol.Alpha_context.Operation_data
              {| contents := contents; signature := None |} |}).

Definition double_endorsement
  (ctxt : Tezos_alpha_test_helpers.Context.t)
  (op1 :
    Tezos_protocol_alpha.Protocol.Alpha_context.operation
      Tezos_protocol_alpha.Protocol.Alpha_context.Kind.endorsement)
  (op2 :
    Tezos_protocol_alpha.Protocol.Alpha_context.operation
      Tezos_protocol_alpha.Protocol.Alpha_context.Kind.endorsement)
  : Lwt.t
    (Tezos_base__TzPervasives.tzresult
      Tezos_protocol_alpha.Protocol.Alpha_context.packed_operation) :=
  let contents :=
    Tezos_protocol_alpha.Protocol.Alpha_context.Single
      (Tezos_protocol_alpha.Protocol.Alpha_context.Double_endorsement_evidence
        {| op1 := op1; op2 := op2 |}) in
  let branch := Context.branch ctxt in
  __return
    {| shell := {| branch := branch |};
      protocol_data :=
        Tezos_protocol_alpha.Protocol.Alpha_context.Operation_data
          {| contents := contents; signature := None |} |}.

Definition double_baking
  (ctxt : Tezos_alpha_test_helpers.Context.t)
  (bh1 : Tezos_protocol_alpha.Protocol.Alpha_context.Block_header.t)
  (bh2 : Tezos_protocol_alpha.Protocol.Alpha_context.Block_header.t)
  : Lwt.t
    (Tezos_base__TzPervasives.tzresult
      Tezos_protocol_alpha.Protocol.Alpha_context.packed_operation) :=
  let contents :=
    Tezos_protocol_alpha.Protocol.Alpha_context.Single
      (Tezos_protocol_alpha.Protocol.Alpha_context.Double_baking_evidence
        {| bh1 := bh1; bh2 := bh2 |}) in
  let branch := Context.branch ctxt in
  __return
    {| shell := {| branch := branch |};
      protocol_data :=
        Tezos_protocol_alpha.Protocol.Alpha_context.Operation_data
          {| contents := contents; signature := None |} |}.

Definition seed_nonce_revelation
  (ctxt : Tezos_alpha_test_helpers.Context.t)
  (level : Tezos_protocol_alpha.Protocol.Alpha_context.Raw_level.t)
  (nonce : Tezos_protocol_alpha.Protocol.Alpha_context.Nonce.t)
  : Lwt.t
    (Tezos_base__TzPervasives.tzresult
      Tezos_protocol_alpha.Protocol.Alpha_context.packed_operation) :=
  __return
    {| shell := {| branch := Context.branch ctxt |};
      protocol_data :=
        Tezos_protocol_alpha.Protocol.Alpha_context.Operation_data
          {|
            contents :=
              Tezos_protocol_alpha.Protocol.Alpha_context.Single
                (Tezos_protocol_alpha.Protocol.Alpha_context.Seed_nonce_revelation
                  {| level := level; nonce := nonce |}); signature := None |} |}.

Definition proposals
  (ctxt : Tezos_alpha_test_helpers.Context.t)
  (pkh : Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t)
  (proposals :
    list
      Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  : Lwt.t
    (Tezos_base__TzPervasives.tzresult
      Tezos_raw_protocol_alpha__Alpha_context.packed_operation) :=
  op_gtgteqquestion (Context.Contract.pkh pkh)
    (fun source =>
      op_gtgteqquestion (Context.Vote.get_voting_period ctxt)
        (fun period =>
          let op :=
            Tezos_protocol_alpha.Protocol.Alpha_context.Proposals
              {| source := source; period := period; proposals := proposals |}
            in
          op_gtgteqquestion (Account.find source)
            (fun account =>
              __return
                (sign None (sk account) ctxt
                  (Tezos_protocol_alpha.Protocol.Alpha_context.Contents_list
                    (Tezos_protocol_alpha.Protocol.Alpha_context.Single op)))))).

Definition ballot
  (ctxt : Tezos_alpha_test_helpers.Context.t)
  (pkh : Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t)
  (proposal :
    Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (ballot : Tezos_protocol_alpha.Protocol.Alpha_context.Vote.ballot)
  : Lwt.t
    (Tezos_base__TzPervasives.tzresult
      Tezos_raw_protocol_alpha__Alpha_context.packed_operation) :=
  op_gtgteqquestion (Context.Contract.pkh pkh)
    (fun source =>
      op_gtgteqquestion (Context.Vote.get_voting_period ctxt)
        (fun period =>
          let op :=
            Tezos_protocol_alpha.Protocol.Alpha_context.Ballot
              {| source := source; period := period; proposal := proposal;
                ballot := ballot |} in
          op_gtgteqquestion (Account.find source)
            (fun account =>
              __return
                (sign None (sk account) ctxt
                  (Tezos_protocol_alpha.Protocol.Alpha_context.Contents_list
                    (Tezos_protocol_alpha.Protocol.Alpha_context.Single op)))))).

Definition dummy_script
  : Tezos_protocol_alpha.Protocol.Alpha_context.Script.t :=
  {|
    code :=
      lazy_expr
        (strip_locations
          (Tezos_micheline.Micheline.Seq 0
            (cons
              (Tezos_micheline.Micheline.Prim 0
                Tezos_protocol_alpha.Protocol.Alpha_context.Script.K_parameter
                (cons
                  (Tezos_micheline.Micheline.Prim 0
                    Tezos_protocol_alpha.Protocol.Alpha_context.Script.T_unit []
                    []) []) [])
              (cons
                (Tezos_micheline.Micheline.Prim 0
                  Tezos_protocol_alpha.Protocol.Alpha_context.Script.K_storage
                  (cons
                    (Tezos_micheline.Micheline.Prim 0
                      Tezos_protocol_alpha.Protocol.Alpha_context.Script.T_unit
                      [] []) []) [])
                (cons
                  (Tezos_micheline.Micheline.Prim 0
                    Tezos_protocol_alpha.Protocol.Alpha_context.Script.K_code
                    (cons
                      (Tezos_micheline.Micheline.Seq 0
                        (cons
                          (Tezos_micheline.Micheline.Prim 0
                            Tezos_protocol_alpha.Protocol.Alpha_context.Script.I_CDR
                            [] [])
                          (cons
                            (Tezos_micheline.Micheline.Prim 0
                              Tezos_protocol_alpha.Protocol.Alpha_context.Script.I_NIL
                              (cons
                                (Tezos_micheline.Micheline.Prim 0
                                  Tezos_protocol_alpha.Protocol.Alpha_context.Script.T_operation
                                  [] []) []) [])
                            (cons
                              (Tezos_micheline.Micheline.Prim 0
                                Tezos_protocol_alpha.Protocol.Alpha_context.Script.I_PAIR
                                [] []) [])))) []) []) [])))));
    storage :=
      lazy_expr
        (strip_locations
          (Tezos_micheline.Micheline.Prim 0
            Tezos_protocol_alpha.Protocol.Alpha_context.Script.D_Unit [] [])) |}.

Definition dummy_script_cost
  : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez :=
  Test_tez.Tez.of_mutez_exn
    (* ❌ Constant of type int64 is converted to int *)
    38000.
test/helpers/op.mli success 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol
open Alpha_context

val endorsement :
  ?delegate:public_key_hash ->
  ?level:Raw_level.t ->
  Context.t ->
  ?signing_context:Context.t ->
  unit ->
  Kind.endorsement Operation.t tzresult Lwt.t

val miss_signed_endorsement :
  ?level:Raw_level.t ->
  Context.t ->
  Kind.endorsement Operation.t tzresult Lwt.t

val transaction :
  ?fee:Tez.tez ->
  ?gas_limit:Z.t ->
  ?storage_limit:Z.t ->
  ?parameters:Script.lazy_expr ->
  ?entrypoint:string ->
  Context.t ->
  Contract.t ->
  Contract.t ->
  Tez.t ->
  Operation.packed tzresult Lwt.t

val delegation :
  ?fee:Tez.tez ->
  Context.t ->
  Contract.t ->
  public_key_hash option ->
  Operation.packed tzresult Lwt.t

val revelation : Context.t -> public_key -> Operation.packed tzresult Lwt.t

val origination :
  ?counter:Z.t ->
  ?delegate:public_key_hash ->
  script:Script.t ->
  ?preorigination:Contract.contract option ->
  ?public_key:public_key ->
  ?credit:Tez.tez ->
  ?fee:Tez.tez ->
  ?gas_limit:Z.t ->
  ?storage_limit:Z.t ->
  Context.t ->
  Contract.contract ->
  (Operation.packed * Contract.contract) tzresult Lwt.t

val originated_contract : Operation.packed -> Contract.contract

val double_endorsement :
  Context.t ->
  Kind.endorsement Operation.t ->
  Kind.endorsement Operation.t ->
  Operation.packed tzresult Lwt.t

val double_baking :
  Context.t ->
  Block_header.block_header ->
  Block_header.block_header ->
  Operation.packed tzresult Lwt.t

val activation :
  Context.t ->
  Signature.Public_key_hash.t ->
  Blinded_public_key_hash.activation_code ->
  Operation.packed tzresult Lwt.t

val combine_operations :
  ?public_key:public_key ->
  ?counter:counter ->
  source:Contract.t ->
  Context.t ->
  packed_operation list ->
  packed_operation tzresult Lwt.t

(** Reveals a seed_nonce that was previously committed at a certain level *)
val seed_nonce_revelation :
  Context.t -> Raw_level.t -> Nonce.t -> Operation.packed tzresult Lwt.t

(** Propose a list of protocol hashes during the approval voting *)
val proposals :
  Context.t ->
  Contract.t ->
  Protocol_hash.t list ->
  Operation.packed tzresult Lwt.t

(** Cast a vote yay, nay or pass *)
val ballot :
  Context.t ->
  Contract.t ->
  Protocol_hash.t ->
  Vote.ballot ->
  Operation.packed tzresult Lwt.t

val dummy_script : Script.t

val dummy_script_cost : Test_tez.Tez.t
op_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter endorsement :
option Tezos_protocol_alpha.Protocol.Alpha_context.public_key_hash ->
  option Tezos_protocol_alpha.Protocol.Alpha_context.Raw_level.t ->
    Tezos_alpha_test_helpers.Context.t ->
      option Tezos_alpha_test_helpers.Context.t ->
        unit ->
          Lwt.t
            (Tezos_base__TzPervasives.tzresult
              (Tezos_protocol_alpha.Protocol.Alpha_context.Operation.t
                Tezos_protocol_alpha.Protocol.Alpha_context.Kind.endorsement)).

Parameter miss_signed_endorsement :
option Tezos_protocol_alpha.Protocol.Alpha_context.Raw_level.t ->
  Tezos_alpha_test_helpers.Context.t ->
    Lwt.t
      (Tezos_base__TzPervasives.tzresult
        (Tezos_protocol_alpha.Protocol.Alpha_context.Operation.t
          Tezos_protocol_alpha.Protocol.Alpha_context.Kind.endorsement)).

Parameter transaction :
option Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez ->
  option Z.t ->
    option Z.t ->
      option Tezos_protocol_alpha.Protocol.Alpha_context.Script.lazy_expr ->
        option string ->
          Tezos_alpha_test_helpers.Context.t ->
            Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t ->
              Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t ->
                Tezos_protocol_alpha.Protocol.Alpha_context.Tez.t ->
                  Lwt.t
                    (Tezos_base__TzPervasives.tzresult
                      Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed).

Parameter delegation :
option Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez ->
  Tezos_alpha_test_helpers.Context.t ->
    Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t ->
      option Tezos_protocol_alpha.Protocol.Alpha_context.public_key_hash ->
        Lwt.t
          (Tezos_base__TzPervasives.tzresult
            Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed).

Parameter revelation :
Tezos_alpha_test_helpers.Context.t ->
  Tezos_protocol_alpha.Protocol.Alpha_context.public_key ->
    Lwt.t
      (Tezos_base__TzPervasives.tzresult
        Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed).

Parameter origination :
option Z.t ->
  option Tezos_protocol_alpha.Protocol.Alpha_context.public_key_hash ->
    Tezos_protocol_alpha.Protocol.Alpha_context.Script.t ->
      option
        (option Tezos_protocol_alpha.Protocol.Alpha_context.Contract.contract)
        ->
        option Tezos_protocol_alpha.Protocol.Alpha_context.public_key ->
          option Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez ->
            option Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez ->
              option Z.t ->
                option Z.t ->
                  Tezos_alpha_test_helpers.Context.t ->
                    Tezos_protocol_alpha.Protocol.Alpha_context.Contract.contract
                      ->
                      Lwt.t
                        (Tezos_base__TzPervasives.tzresult
                          (Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed
                            *
                            Tezos_protocol_alpha.Protocol.Alpha_context.Contract.contract)).

Parameter originated_contract :
Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed ->
  Tezos_protocol_alpha.Protocol.Alpha_context.Contract.contract.

Parameter double_endorsement :
Tezos_alpha_test_helpers.Context.t ->
  Tezos_protocol_alpha.Protocol.Alpha_context.Operation.t
    Tezos_protocol_alpha.Protocol.Alpha_context.Kind.endorsement ->
    Tezos_protocol_alpha.Protocol.Alpha_context.Operation.t
      Tezos_protocol_alpha.Protocol.Alpha_context.Kind.endorsement ->
      Lwt.t
        (Tezos_base__TzPervasives.tzresult
          Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed).

Parameter double_baking :
Tezos_alpha_test_helpers.Context.t ->
  Tezos_protocol_alpha.Protocol.Alpha_context.Block_header.block_header ->
    Tezos_protocol_alpha.Protocol.Alpha_context.Block_header.block_header ->
      Lwt.t
        (Tezos_base__TzPervasives.tzresult
          Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed).

Parameter activation :
Tezos_alpha_test_helpers.Context.t ->
  Tezos_base__TzPervasives.Signature.Public_key_hash.t ->
    Tezos_protocol_alpha.Protocol.Blinded_public_key_hash.activation_code ->
      Lwt.t
        (Tezos_base__TzPervasives.tzresult
          Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed).

Parameter combine_operations :
option Tezos_protocol_alpha.Protocol.Alpha_context.public_key ->
  option Tezos_protocol_alpha.Protocol.Alpha_context.counter ->
    Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t ->
      Tezos_alpha_test_helpers.Context.t ->
        list Tezos_protocol_alpha.Protocol.Alpha_context.packed_operation ->
          Lwt.t
            (Tezos_base__TzPervasives.tzresult
              Tezos_protocol_alpha.Protocol.Alpha_context.packed_operation).

Parameter seed_nonce_revelation :
Tezos_alpha_test_helpers.Context.t ->
  Tezos_protocol_alpha.Protocol.Alpha_context.Raw_level.t ->
    Tezos_protocol_alpha.Protocol.Alpha_context.Nonce.t ->
      Lwt.t
        (Tezos_base__TzPervasives.tzresult
          Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed).

Parameter proposals :
Tezos_alpha_test_helpers.Context.t ->
  Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t ->
    list Tezos_base__TzPervasives.Protocol_hash.t ->
      Lwt.t
        (Tezos_base__TzPervasives.tzresult
          Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed).

Parameter ballot :
Tezos_alpha_test_helpers.Context.t ->
  Tezos_protocol_alpha.Protocol.Alpha_context.Contract.t ->
    Tezos_base__TzPervasives.Protocol_hash.t ->
      Tezos_protocol_alpha.Protocol.Alpha_context.Vote.ballot ->
        Lwt.t
          (Tezos_base__TzPervasives.tzresult
            Tezos_protocol_alpha.Protocol.Alpha_context.Operation.packed).

Parameter dummy_script : Tezos_protocol_alpha.Protocol.Alpha_context.Script.t.

Parameter dummy_script_cost : Tezos_alpha_test_helpers.Test_tez.Tez.t.
test/helpers/test_tez.ml 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol
open Alpha_context
open Environment

(* This module is mostly to wrap the errors from the protocol *)
module Tez = struct
  include Tez

  let ( +? ) t1 t2 = t1 +? t2 |> wrap_error

  let ( -? ) t1 t2 = t1 -? t2 |> wrap_error

  let ( *? ) t1 t2 = t1 *? t2 |> wrap_error

  let ( /? ) t1 t2 = t1 /? t2 |> wrap_error

  let ( + ) t1 t2 =
    match t1 +? t2 with
    | Ok r ->
        r
    | Error _ ->
        Pervasives.failwith "adding tez"

  let of_int x =
    match Tez.of_mutez (Int64.mul (Int64.of_int x) 1_000_000L) with
    | None ->
        invalid_arg "tez_of_int"
    | Some x ->
        x

  let of_mutez_exn x =
    match Tez.of_mutez x with
    | None ->
        invalid_arg "tez_of_mutez"
    | Some x ->
        x

  let max_tez =
    match Tez.of_mutez Int64.max_int with None -> assert false | Some p -> p
end
test_tez_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Protocol.

Import Alpha_context.

Import Environment.

Module Tez.
  Export Tez.
  
  Definition op_plusquestion (t1 : tez) (t2 : tez)
    : Tezos_base__TzPervasives.Error_monad.tzresult tez :=
    OCaml.Stdlib.reverse_apply (op_plusquestion t1 t2) wrap_error.
  
  Definition op_minusquestion (t1 : tez) (t2 : tez)
    : Tezos_base__TzPervasives.Error_monad.tzresult tez :=
    OCaml.Stdlib.reverse_apply (op_minusquestion t1 t2) wrap_error.
  
  Definition op_starquestion (t1 : tez) (t2 : int64)
    : Tezos_base__TzPervasives.Error_monad.tzresult tez :=
    OCaml.Stdlib.reverse_apply (op_starquestion t1 t2) wrap_error.
  
  Definition op_divquestion (t1 : tez) (t2 : int64)
    : Tezos_base__TzPervasives.Error_monad.tzresult tez :=
    OCaml.Stdlib.reverse_apply (op_divquestion t1 t2) wrap_error.
  
  Definition op_plus (t1 : tez) (t2 : tez) : tez :=
    match op_plusquestion t1 t2 with
    | Stdlib.Ok r => r
    | Stdlib.Error _ => Pervasives.failwith "adding tez" % string
    end.
  
  Definition of_int (x : Z)
    : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez :=
    match
      Tez.of_mutez
        (Int64.mul (Int64.of_int x)
          (* ❌ Constant of type int64 is converted to int *)
          1000000) with
    | None => OCaml.Stdlib.invalid_arg "tez_of_int" % string
    | Some x => x
    end.
  
  Definition of_mutez_exn (x : int64)
    : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez :=
    match Tez.of_mutez x with
    | None => OCaml.Stdlib.invalid_arg "tez_of_mutez" % string
    | Some x => x
    end.
  
  Definition max_tez : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez :=
    match Tez.of_mutez Int64.max_int with
    | None =>
      (* ❌ Assert instruction is not handled. *)
      assert false
    | Some p => p
    end.
End Tez.
test/helpers/test_utils.ml 1 error 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* This file should not depend on any other file from tests. *)

let ( >>?= ) x y = match x with Ok a -> y a | Error b -> fail @@ List.hd b

(** Like List.find but returns the index of the found element *)
let findi p =
  let rec aux p i = function
    | [] ->
        raise Not_found
    | x :: l ->
        if p x then (x, i) else aux p (i + 1) l
  in
  aux p 0

exception Pair_of_list

let pair_of_list = function [a; b] -> (a, b) | _ -> raise Pair_of_list
test_utils_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition op_gtgtquestioneq {A B : Type}
  (x : sum A (list Tezos_base__TzPervasives.error))
  (y : A -> Lwt.t (Tezos_base__TzPervasives.tzresult B))
  : Lwt.t (Tezos_base__TzPervasives.tzresult B) :=
  match x with
  | Stdlib.Ok a => y a
  | Stdlib.Error b => apply fail (List.hd b)
  end.

Definition findi {A : Type} (p : A -> bool) : list A -> A * Z :=
  let fix aux {B : Type} (p : B -> bool) (i : Z) (function_parameter : list B)
    : B * Z :=
    match function_parameter with
    | [] => Stdlib.raise OCaml.Not_found
    | cons x l =>
      if p x then
        (x, i)
      else
        aux p (Z.add i 1) l
    end in
  aux p 0.

(* ❌ The definition of exceptions is not handled. *)
exception

Definition pair_of_list {A : Type} (function_parameter : list A) : A * A :=
  match function_parameter with
  | cons a (cons b []) => (a, b)
  | _ => Stdlib.raise Pair_of_list
  end.
test/main.ml 16 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

let () =
  Alcotest.run
    "protocol_alpha"
    [ ("transfer", Transfer.tests);
      ("origination", Origination.tests);
      ("activation", Activation.tests);
      ("endorsement", Endorsement.tests);
      ("double endorsement", Double_endorsement.tests);
      ("double baking", Double_baking.tests);
      ("seed", Seed.tests);
      ("baking", Baking.tests);
      ("delegation", Delegation.tests);
      ("rolls", Rolls.tests);
      ("combined", Combined_operations.tests);
      ("qty", Qty.tests);
      ("voting", Voting.tests) ]
main_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  op_startypeminuserrorstar "protocol_alpha" % string
    (cons ("transfer" % string, op_startypeminuserrorstar)
      (cons ("origination" % string, op_startypeminuserrorstar)
        (cons ("activation" % string, op_startypeminuserrorstar)
          (cons ("endorsement" % string, op_startypeminuserrorstar)
            (cons ("double endorsement" % string, op_startypeminuserrorstar)
              (cons ("double baking" % string, op_startypeminuserrorstar)
                (cons ("seed" % string, op_startypeminuserrorstar)
                  (cons ("baking" % string, op_startypeminuserrorstar)
                    (cons ("delegation" % string, op_startypeminuserrorstar)
                      (cons ("rolls" % string, op_startypeminuserrorstar)
                        (cons ("combined" % string, op_startypeminuserrorstar)
                          (cons ("qty" % string, op_startypeminuserrorstar)
                            (cons ("voting" % string, op_startypeminuserrorstar)
                              []))))))))))))).
test/origination.ml 118 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol
open Test_utils
open Test_tez

let ten_tez = Tez.of_int 10

(** [register_origination fee credit spendable delegatable] takes four
    optional parameter: fee for the fee need to be paid if set to
    create an originated contract; credit is the amount of tez that
    send to this originated contract; spendable default is set to true
    meaning that this contract is spendable; delegatable default is
    set to true meaning that this contract is able to delegate. *)
let register_origination ?(fee = Tez.zero) ?(credit = Tez.zero) () =
  Context.init 1
  >>=? fun (b, contracts) ->
  let source = List.hd contracts in
  Context.Contract.balance (B b) source
  >>=? fun source_balance ->
  Op.origination (B b) source ~fee ~credit ~script:Op.dummy_script
  >>=? fun (operation, originated) ->
  Block.bake ~operation b
  >>=? fun b ->
  (* fee + credit + block security deposit were debited from source *)
  Context.get_constants (B b)
  >>=? fun { parametric =
               {origination_size; cost_per_byte; block_security_deposit; _};
             _ } ->
  Tez.(cost_per_byte *? Int64.of_int origination_size)
  >>?= fun origination_burn ->
  Lwt.return
    ( Tez.( +? ) credit block_security_deposit
    >>? Tez.( +? ) fee
    >>? Tez.( +? ) origination_burn
    >>? Tez.( +? ) Op.dummy_script_cost )
  >>=? fun total_fee ->
  Assert.balance_was_debited ~loc:__LOC__ (B b) source source_balance total_fee
  >>=? fun () ->
  (* originated contract has been credited *)
  Assert.balance_was_credited ~loc:__LOC__ (B b) originated Tez.zero credit
  >>=? fun () ->
  (* TODO spendable or not and delegatable or not if relevant for some
     test. Not the case at the moment, cf. uses of
     register_origination *)
  return (b, source, originated)

(* [test_origination_balances fee credit spendable delegatable]
   takes four optional parameter: fee is the fee that pay if require to create
   an originated contract; credit is the amount of tez that will send to this
   contract; delegatable default is set to true meaning that this contract is
   able to delegate.
   This function will create a contract, get the balance of this contract, call
   the origination operation to create a new originated contract from this
   contract with all the possible fees; and check the balance before/after
   originated operation valid.
   - the source contract has payed all the fees
   - the originated has been credited correctly *)
let test_origination_balances ~loc:_ ?(fee = Tez.zero) ?(credit = Tez.zero) ()
    =
  Context.init 1
  >>=? fun (b, contracts) ->
  let contract = List.hd contracts in
  Context.Contract.balance (B b) contract
  >>=? fun balance ->
  Op.origination (B b) contract ~fee ~credit ~script:Op.dummy_script
  >>=? fun (operation, new_contract) ->
  (* The possible fees are: a given credit, an origination burn fee
     (constants_repr.default.origination_burn = 257 mtez),
     a fee that is paid when creating an originate contract.

     We also take into account a block security deposit. Note that it
     is not related to origination but to the baking done in the
     tests.*)
  Context.get_constants (B b)
  >>=? fun { parametric =
               {origination_size; cost_per_byte; block_security_deposit; _};
             _ } ->
  Tez.(cost_per_byte *? Int64.of_int origination_size)
  >>?= fun origination_burn ->
  Lwt.return
    ( Tez.( +? ) credit block_security_deposit
    >>? Tez.( +? ) fee
    >>? Tez.( +? ) origination_burn
    >>? Tez.( +? ) Op.dummy_script_cost )
  >>=? fun total_fee ->
  Block.bake ~operation b
  >>=? fun b ->
  (* check that after the block has been baked the source contract
     was debited all the fees *)
  Assert.balance_was_debited ~loc:__LOC__ (B b) contract balance total_fee
  >>=? fun _ ->
  (* check the balance of the originate contract is equal to credit *)
  Assert.balance_is ~loc:__LOC__ (B b) new_contract credit

(******************************************************)
(** Tests *)

(******************************************************)

(** compute half of the balance and divided it by nth times *)

let two_nth_of_balance incr contract nth =
  Context.Contract.balance (I incr) contract
  >>=? fun balance ->
  Tez.( /? ) balance nth
  >>?= fun res -> Tez.( *? ) res 2L >>?= fun balance -> return balance

(*******************)
(** Basic test *)

(*******************)

let balances_simple () = test_origination_balances ~loc:__LOC__ ()

let balances_credit () =
  test_origination_balances ~loc:__LOC__ ~credit:ten_tez ()

let balances_credit_fee () =
  test_origination_balances ~loc:__LOC__ ~credit:(Tez.of_int 2) ~fee:ten_tez ()

let balances_undelegatable () = test_origination_balances ~loc:__LOC__ ()

(*******************)
(** ask source contract to pay a fee when originating a contract *)

(*******************)

let pay_fee () =
  register_origination ~credit:(Tez.of_int 2) ~fee:ten_tez ()
  >>=? fun (_b, _contract, _new_contract) -> return_unit

(******************************************************)
(** Errors *)

(******************************************************)

(*******************)
(** create an originate contract where the contract
    does not have enough tez to pay for the fee *)

(*******************)

let not_tez_in_contract_to_pay_fee () =
  Context.init 2
  >>=? fun (b, contracts) ->
  let contract_1 = List.nth contracts 0 in
  let contract_2 = List.nth contracts 1 in
  Incremental.begin_construction b
  >>=? fun inc ->
  (* transfer everything but one tez from 1 to 2 and check balance of 1 *)
  Context.Contract.balance (I inc) contract_1
  >>=? fun balance ->
  Lwt.return @@ Tez.( -? ) balance Tez.one
  >>=? fun amount ->
  Op.transaction (I inc) contract_1 contract_2 amount
  >>=? fun operation ->
  Incremental.add_operation inc operation
  >>=? fun inc ->
  Assert.balance_was_debited ~loc:__LOC__ (I inc) contract_1 balance amount
  >>=? fun _ ->
  (* use this source contract to create an originate contract where it requires
     to pay a fee and add an amount of credit into this new contract *)
  Op.origination
    (I inc)
    ~fee:ten_tez
    ~credit:Tez.one
    contract_1
    ~script:Op.dummy_script
  >>=? fun (op, _) ->
  Incremental.add_operation inc op
  >>= fun inc ->
  Assert.proto_error ~loc:__LOC__ inc (function
      | Contract_storage.Balance_too_low _ ->
          true
      | _ ->
          false)

(***************************************************)
(* set the endorser of the block as manager/delegate of the originated
   account *)
(***************************************************)

let register_contract_get_endorser () =
  Context.init 1
  >>=? fun (b, contracts) ->
  let contract = List.hd contracts in
  Incremental.begin_construction b
  >>=? fun inc ->
  Context.get_endorser (I inc)
  >>=? fun (account_endorser, _slots) ->
  return (inc, contract, account_endorser)

(*******************)
(** create multiple originated contracts and
    ask contract to pay the fee *)

(*******************)

let n_originations n ?credit ?fee () =
  fold_left_s
    (fun new_contracts _ ->
      register_origination ?fee ?credit ()
      >>=? fun (_b, _source, new_contract) ->
      let contracts = new_contract :: new_contracts in
      return contracts)
    []
    (1 -- n)

let multiple_originations () =
  n_originations 100 ~credit:(Tez.of_int 2) ~fee:ten_tez ()
  >>=? fun contracts ->
  Assert.equal_int ~loc:__LOC__ (List.length contracts) 100

(*******************)
(** cannot originate two contracts with the same context's counter *)

(*******************)

let counter () =
  Context.init 1
  >>=? fun (b, contracts) ->
  let contract = List.hd contracts in
  Incremental.begin_construction b
  >>=? fun inc ->
  Op.origination (I inc) ~credit:Tez.one contract ~script:Op.dummy_script
  >>=? fun (op1, _) ->
  Op.origination (I inc) ~credit:Tez.one contract ~script:Op.dummy_script
  >>=? fun (op2, _) ->
  Incremental.add_operation inc op1
  >>=? fun inc ->
  Incremental.add_operation inc op2
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Contract_storage.Counter_in_the_past _ ->
          true
      | _ ->
          false)

(******************************************************)

let tests =
  [ Test.tztest "balances_simple" `Quick balances_simple;
    Test.tztest "balances_credit" `Quick balances_credit;
    Test.tztest "balances_credit_fee" `Quick balances_credit_fee;
    Test.tztest "balances_undelegatable" `Quick balances_undelegatable;
    Test.tztest "pay_fee" `Quick pay_fee;
    Test.tztest
      "not enough tez in contract to pay fee"
      `Quick
      not_tez_in_contract_to_pay_fee;
    Test.tztest "multiple originations" `Quick multiple_originations;
    Test.tztest "counter" `Quick counter ]
origination_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Protocol.

Definition ten_tez {A : Type} : A := op_startypeminuserrorstar 10.

Definition register_origination {A B C : Type} (op_staroptstar : option A)
  : option B ->
    unit ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult C) :=
  let fee :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => op_startypeminuserrorstar
    end in
  fun op_staroptstar =>
    let credit :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => op_startypeminuserrorstar
      end in
    fun function_parameter =>
      let 'tt := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar 1)
        (fun function_parameter =>
          let '(b, contracts) := function_parameter in
          let source := List.hd contracts in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar source)
            (fun source_balance =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar source fee
                  credit op_startypeminuserrorstar)
                (fun function_parameter =>
                  let '(operation, originated) := function_parameter in
                  op_gtgteqquestion (op_startypeminuserrorstar operation b)
                    (fun b =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar)
                        (fun function_parameter =>
                          let '_ := function_parameter in
                          op_startypeminuserrorstar op_startypeminuserrorstar
                            (fun origination_burn =>
                              op_gtgteqquestion
                                (Lwt.__return
                                  (op_gtgtquestion
                                    (op_gtgtquestion
                                      (op_gtgtquestion
                                        (op_startypeminuserrorstar credit
                                          op_startypeminuserrorstar)
                                        (op_startypeminuserrorstar fee))
                                      (op_startypeminuserrorstar
                                        origination_burn))
                                    (op_startypeminuserrorstar
                                      op_startypeminuserrorstar)))
                                (fun total_fee =>
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar __LOC__
                                      op_startypeminuserrorstar source
                                      source_balance total_fee)
                                    (fun function_parameter =>
                                      let 'tt := function_parameter in
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar __LOC__
                                          op_startypeminuserrorstar originated
                                          op_startypeminuserrorstar credit)
                                        (fun function_parameter =>
                                          let 'tt := function_parameter in
                                          __return (b, source, originated)))))))))).

Definition test_origination_balances {A B C D : Type} (function_parameter : A)
  : option B ->
    option C ->
      unit ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult D) :=
  let '_ := function_parameter in
  fun op_staroptstar =>
    let fee :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => op_startypeminuserrorstar
      end in
    fun op_staroptstar =>
      let credit :=
        match op_staroptstar with
        | Some op_starsthstar => op_starsthstar
        | None => op_startypeminuserrorstar
        end in
      fun function_parameter =>
        let 'tt := function_parameter in
        op_gtgteqquestion (op_startypeminuserrorstar 1)
          (fun function_parameter =>
            let '(b, contracts) := function_parameter in
            let contract := List.hd contracts in
            op_gtgteqquestion
              (op_startypeminuserrorstar op_startypeminuserrorstar contract)
              (fun balance =>
                op_gtgteqquestion
                  (op_startypeminuserrorstar op_startypeminuserrorstar contract
                    fee credit op_startypeminuserrorstar)
                  (fun function_parameter =>
                    let '(operation, new_contract) := function_parameter in
                    op_gtgteqquestion
                      (op_startypeminuserrorstar op_startypeminuserrorstar)
                      (fun function_parameter =>
                        let '_ := function_parameter in
                        op_startypeminuserrorstar op_startypeminuserrorstar
                          (fun origination_burn =>
                            op_gtgteqquestion
                              (Lwt.__return
                                (op_gtgtquestion
                                  (op_gtgtquestion
                                    (op_gtgtquestion
                                      (op_startypeminuserrorstar credit
                                        op_startypeminuserrorstar)
                                      (op_startypeminuserrorstar fee))
                                    (op_startypeminuserrorstar origination_burn))
                                  (op_startypeminuserrorstar
                                    op_startypeminuserrorstar)))
                              (fun total_fee =>
                                op_gtgteqquestion
                                  (op_startypeminuserrorstar operation b)
                                  (fun b =>
                                    op_gtgteqquestion
                                      (op_startypeminuserrorstar __LOC__
                                        op_startypeminuserrorstar contract
                                        balance total_fee)
                                      (fun function_parameter =>
                                        let '_ := function_parameter in
                                        op_startypeminuserrorstar __LOC__
                                          op_startypeminuserrorstar new_contract
                                          credit)))))))).

Definition two_nth_of_balance {A B C D : Type}
  (incr : A) (contract : B) (nth : C)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult D) :=
  op_gtgteqquestion
    (op_startypeminuserrorstar op_startypeminuserrorstar contract)
    (fun balance =>
      op_startypeminuserrorstar (op_startypeminuserrorstar balance nth)
        (fun res =>
          op_startypeminuserrorstar
            (op_startypeminuserrorstar res
              (* ❌ Constant of type int64 is converted to int *)
              2) (fun balance => __return balance))).

Definition balances_simple {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  test_origination_balances __LOC__ None None tt.

Definition balances_credit {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  test_origination_balances __LOC__ None (Some ten_tez) tt.

Definition balances_credit_fee {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  test_origination_balances __LOC__ (Some ten_tez)
    (Some (op_startypeminuserrorstar 2)) tt.

Definition balances_undelegatable {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  test_origination_balances __LOC__ None None tt.

Definition pay_fee (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion
    (register_origination (Some ten_tez) (Some (op_startypeminuserrorstar 2)) tt)
    (fun function_parameter =>
      let '(_b, _contract, _new_contract) := function_parameter in
      return_unit).

Definition not_tez_in_contract_to_pay_fee {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(b, contracts) := function_parameter in
      let contract_1 := op_startypeminuserrorstar contracts 0 in
      let contract_2 := op_startypeminuserrorstar contracts 1 in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun inc =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar contract_1)
            (fun balance =>
              op_gtgteqquestion
                (op_atat Lwt.__return
                  (op_startypeminuserrorstar balance op_startypeminuserrorstar))
                (fun amount =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      contract_1 contract_2 amount)
                    (fun operation =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar inc operation)
                        (fun inc =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar __LOC__
                              op_startypeminuserrorstar contract_1 balance
                              amount)
                            (fun function_parameter =>
                              let '_ := function_parameter in
                              op_gtgteqquestion
                                (op_startypeminuserrorstar
                                  op_startypeminuserrorstar ten_tez
                                  op_startypeminuserrorstar contract_1
                                  op_startypeminuserrorstar)
                                (fun function_parameter =>
                                  let '(op, _) := function_parameter in
                                  op_gtgteq (op_startypeminuserrorstar inc op)
                                    (fun inc =>
                                      op_startypeminuserrorstar __LOC__ inc
                                        (fun function_parameter =>
                                          match function_parameter with
                                          |
                                            Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                              _ _ _ => true
                                          | _ => false
                                          end)))))))))).

Definition register_contract_get_endorser {A B C : Type}
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (A * B * C)) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, contracts) := function_parameter in
      let contract := List.hd contracts in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun inc =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar)
            (fun function_parameter =>
              let '(account_endorser, _slots) := function_parameter in
              __return (inc, contract, account_endorser)))).

Definition n_originations {A B C D : Type}
  (n : A) (credit : option B) (fee : option C) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult (list D)) :=
  let 'tt := function_parameter in
  fold_left_s
    (fun new_contracts =>
      fun function_parameter =>
        let '_ := function_parameter in
        op_gtgteqquestion (register_origination fee credit tt)
          (fun function_parameter =>
            let '(_b, _source, new_contract) := function_parameter in
            let contracts := cons new_contract new_contracts in
            __return contracts)) [] (op_startypeminuserrorstar 1 n).

Definition multiple_originations {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion
    (n_originations 100 (Some (op_startypeminuserrorstar 2)) (Some ten_tez) tt)
    (fun contracts =>
      op_startypeminuserrorstar __LOC__ (List.length contracts) 100).

Definition counter {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, contracts) := function_parameter in
      let contract := List.hd contracts in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun inc =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar
              op_startypeminuserrorstar contract op_startypeminuserrorstar)
            (fun function_parameter =>
              let '(op1, _) := function_parameter in
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar
                  op_startypeminuserrorstar contract op_startypeminuserrorstar)
                (fun function_parameter =>
                  let '(op2, _) := function_parameter in
                  op_gtgteqquestion (op_startypeminuserrorstar inc op1)
                    (fun inc =>
                      op_gtgteq (op_startypeminuserrorstar inc op2)
                        (fun res =>
                          op_startypeminuserrorstar __LOC__ res
                            (fun function_parameter =>
                              match function_parameter with
                              |
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Counter_in_the_past
                                  _ _ _ => true
                              | _ => false
                              end))))))).

Definition tests {A : Type} : list A :=
  cons
    (op_startypeminuserrorstar "balances_simple" % string
      (* ❌ Variants not supported *)
      variant balances_simple)
    (cons
      (op_startypeminuserrorstar "balances_credit" % string
        (* ❌ Variants not supported *)
        variant balances_credit)
      (cons
        (op_startypeminuserrorstar "balances_credit_fee" % string
          (* ❌ Variants not supported *)
          variant balances_credit_fee)
        (cons
          (op_startypeminuserrorstar "balances_undelegatable" % string
            (* ❌ Variants not supported *)
            variant balances_undelegatable)
          (cons
            (op_startypeminuserrorstar "pay_fee" % string
              (* ❌ Variants not supported *)
              variant pay_fee)
            (cons
              (op_startypeminuserrorstar
                "not enough tez in contract to pay fee" % string
                (* ❌ Variants not supported *)
                variant not_tez_in_contract_to_pay_fee)
              (cons
                (op_startypeminuserrorstar "multiple originations" % string
                  (* ❌ Variants not supported *)
                  variant multiple_originations)
                (cons
                  (op_startypeminuserrorstar "counter" % string
                    (* ❌ Variants not supported *)
                    variant counter) []))))))).
test/qty.ml 14 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol

let known_ok_tez_literals =
  [ (0L, "0");
    (10L, "0.00001");
    (100L, "0.0001");
    (1_000L, "0.001");
    (10_000L, "0.01");
    (100_000L, "0.1");
    (1_000_000L, "1");
    (10_000_000L, "10");
    (100_000_000L, "100");
    (1_000_000_000L, "1000");
    (10_000_000_000L, "10000");
    (100_000_000_000L, "100000");
    (1_000_000_000_000L, "1000000");
    (1_000_000_000_001L, "1000000.000001");
    (1_000_000_000_010L, "1000000.00001");
    (1_000_000_000_100L, "1000000.0001");
    (1_000_000_001_000L, "1000000.001");
    (1_000_000_010_000L, "1000000.01");
    (1_000_000_100_000L, "1000000.1");
    (123_123_123_123_123_123L, "123123123123.123123");
    (999_999_999_999_999_999L, "999999999999.999999") ]

let known_bad_tez_literals =
  [ "10000.";
    "100,.";
    "100,";
    "1,0000";
    "0.0000,1";
    "0.00,1";
    "0,1";
    "HAHA";
    "0.000,000,1";
    "0.0000000";
    "9,999,999,999,999.999,999" ]

let fail expected given msg =
  Format.kasprintf
    Pervasives.failwith
    "@[%s@ expected: %s@ got: %s@]"
    msg
    expected
    given

let fail_msg fmt = Format.kasprintf (fail "" "") fmt

let default_printer _ = ""

let equal ?(eq = ( = )) ?(prn = default_printer) ?(msg = "") x y =
  if not (eq x y) then fail (prn x) (prn y) msg

let is_none ?(msg = "") x = if x <> None then fail "None" "Some _" msg

let is_some ?(msg = "") x = if x = None then fail "Some _" "None" msg

let test_known_tez_literals () =
  List.iter
    (fun (v, s) ->
      let vv = Tez_repr.of_mutez v in
      let vs = Tez_repr.of_string s in
      let vs' =
        Tez_repr.of_string (String.concat "" (String.split_on_char ',' s))
      in
      let vv =
        match vv with
        | None ->
            fail_msg "could not unopt %Ld" v
        | Some vv ->
            vv
      in
      let vs =
        match vs with None -> fail_msg "could not unopt %s" s | Some vs -> vs
      in
      let vs' =
        match vs' with
        | None ->
            fail_msg "could not unopt %s" s
        | Some vs' ->
            vs'
      in
      equal ~prn:Tez_repr.to_string vv vs ;
      equal ~prn:Tez_repr.to_string vv vs' ;
      equal ~prn:(fun s -> s) (Tez_repr.to_string vv) s)
    known_ok_tez_literals ;
  List.iter
    (fun s ->
      let vs = Tez_repr.of_string s in
      is_none ~msg:("Unexpected successful parsing of " ^ s) vs)
    known_bad_tez_literals ;
  return_unit

let test_random_tez_literals () =
  for _ = 0 to 100_000 do
    let v = Random.int64 12L in
    let vv = Tez_repr.of_mutez v in
    let vv =
      match vv with None -> fail_msg "could not unopt %Ld" v | Some vv -> vv
    in
    let s = Tez_repr.to_string vv in
    let vs = Tez_repr.of_string s in
    let s' = String.concat "" (String.split_on_char ',' s) in
    let vs' = Tez_repr.of_string s' in
    is_some ~msg:("Could not parse " ^ s ^ " back") vs ;
    is_some ~msg:("Could not parse " ^ s ^ " back") vs' ;
    ( match vs with
    | None ->
        assert false
    | Some vs ->
        let rev = Tez_repr.to_int64 vs in
        equal ~prn:Int64.to_string ~msg:(Tez_repr.to_string vv) v rev ) ;
    match vs' with
    | None ->
        assert false
    | Some vs' ->
        let rev = Tez_repr.to_int64 vs' in
        equal ~prn:Int64.to_string ~msg:(Tez_repr.to_string vv) v rev
  done ;
  return_unit

let tests =
  [ ("tez-literals", fun _ -> test_known_tez_literals ());
    ("rnd-tez-literals", fun _ -> test_random_tez_literals ()) ]

let wrap (n, f) =
  Alcotest_lwt.test_case n `Quick (fun _ () ->
      f ()
      >>= function
      | Ok () ->
          Lwt.return_unit
      | Error error ->
          Format.kasprintf Pervasives.failwith "%a" pp_print_error error)

let tests = List.map wrap tests
qty_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Protocol.

Definition known_ok_tez_literals : list (int64 * string) :=
  cons
    ((* ❌ Constant of type int64 is converted to int *)
    0, "0" % string)
    (cons
      ((* ❌ Constant of type int64 is converted to int *)
      10, "0.00001" % string)
      (cons
        ((* ❌ Constant of type int64 is converted to int *)
        100, "0.0001" % string)
        (cons
          ((* ❌ Constant of type int64 is converted to int *)
          1000, "0.001" % string)
          (cons
            ((* ❌ Constant of type int64 is converted to int *)
            10000, "0.01" % string)
            (cons
              ((* ❌ Constant of type int64 is converted to int *)
              100000, "0.1" % string)
              (cons
                ((* ❌ Constant of type int64 is converted to int *)
                1000000, "1" % string)
                (cons
                  ((* ❌ Constant of type int64 is converted to int *)
                  10000000, "10" % string)
                  (cons
                    ((* ❌ Constant of type int64 is converted to int *)
                    100000000, "100" % string)
                    (cons
                      ((* ❌ Constant of type int64 is converted to int *)
                      1000000000, "1000" % string)
                      (cons
                        ((* ❌ Constant of type int64 is converted to int *)
                        10000000000, "10000" % string)
                        (cons
                          ((* ❌ Constant of type int64 is converted to int *)
                          100000000000, "100000" % string)
                          (cons
                            ((* ❌ Constant of type int64 is converted to int *)
                            1000000000000, "1000000" % string)
                            (cons
                              ((* ❌ Constant of type int64 is converted to int *)
                              1000000000001, "1000000.000001" % string)
                              (cons
                                ((* ❌ Constant of type int64 is converted to int *)
                                1000000000010, "1000000.00001" % string)
                                (cons
                                  ((* ❌ Constant of type int64 is converted to int *)
                                  1000000000100, "1000000.0001" % string)
                                  (cons
                                    ((* ❌ Constant of type int64 is converted to int *)
                                    1000000001000, "1000000.001" % string)
                                    (cons
                                      ((* ❌ Constant of type int64 is converted to int *)
                                      1000000010000, "1000000.01" % string)
                                      (cons
                                        ((* ❌ Constant of type int64 is converted to int *)
                                        1000000100000, "1000000.1" % string)
                                        (cons
                                          ((* ❌ Constant of type int64 is converted to int *)
                                          123123123123123123,
                                            "123123123123.123123" % string)
                                          (cons
                                            ((* ❌ Constant of type int64 is converted to int *)
                                            999999999999999999,
                                              "999999999999.999999" % string) [])))))))))))))))))))).

Definition known_bad_tez_literals : list string :=
  cons "10000." % string
    (cons "100,." % string
      (cons "100," % string
        (cons "1,0000" % string
          (cons "0.0000,1" % string
            (cons "0.00,1" % string
              (cons "0,1" % string
                (cons "HAHA" % string
                  (cons "0.000,000,1" % string
                    (cons "0.0000000" % string
                      (cons "9,999,999,999,999.999,999" % string [])))))))))).

Definition fail {A : Type} (expected : string) (given : string) (msg : string)
  : A :=
  Format.kasprintf Pervasives.failwith
    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_gen
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Open_box
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
            Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format
            "" % string))
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Break
              "@ " % string 1 0)
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
              "expected: " % string
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Break
                    "@ " % string 1 0)
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                    "got: " % string
                    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                      Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Formatting_lit
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Close_box
                        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)))))))))
      "@[%s@ expected: %s@ got: %s@]" % string) msg expected given.

Definition fail_msg {A B : Type}
  (fmt :
    Tezos_protocol_environment_alpha__Environment.Pervasives.format4 A
      Tezos_protocol_environment_alpha__Environment.Format.formatter unit B)
  : A := Format.kasprintf (fail "" % string "" % string) fmt.

Definition default_printer {A : Type} (function_parameter : A) : string :=
  let '_ := function_parameter in
  "" % string.

Definition equal {A : Type} (op_staroptstar : option (A -> A -> bool))
  : option (A -> string) -> option string -> A -> A -> unit :=
  let eq :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => op_startypeminuserrorstar
    end in
  fun op_staroptstar =>
    let prn :=
      match op_staroptstar with
      | Some op_starsthstar => op_starsthstar
      | None => default_printer
      end in
    fun op_staroptstar =>
      let msg :=
        match op_staroptstar with
        | Some op_starsthstar => op_starsthstar
        | None => "" % string
        end in
      fun x =>
        fun y =>
          if not (eq x y) then
            fail (prn x) (prn y) msg
          else
            tt.

Definition is_none {A : Type} (op_staroptstar : option string) : A -> unit :=
  let msg :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => "" % string
    end in
  fun x =>
    if op_startypeminuserrorstar x None then
      fail "None" % string "Some _" % string msg
    else
      tt.

Definition is_some {A : Type} (op_staroptstar : option string) : A -> unit :=
  let msg :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => "" % string
    end in
  fun x =>
    if op_startypeminuserrorstar x None then
      fail "Some _" % string "None" % string msg
    else
      tt.

Definition test_known_tez_literals (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    List.iter
      (fun function_parameter =>
        let '(v, s) := function_parameter in
        let vv := Tez_repr.of_mutez v in
        let vs := Tez_repr.of_string s in
        let vs' :=
          Tez_repr.of_string
            (String.concat "" % string (String.split_on_char "," % char s)) in
        let vv :=
          match vv with
          | None =>
            fail_msg
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "could not unopt " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int64
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))
                "could not unopt %Ld" % string) v
          | Some vv => vv
          end in
        let vs :=
          match vs with
          | None =>
            fail_msg
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "could not unopt " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))
                "could not unopt %s" % string) s
          | Some vs => vs
          end in
        let vs' :=
          match vs' with
          | None =>
            fail_msg
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "could not unopt " % string
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))
                "could not unopt %s" % string) s
          | Some vs' => vs'
          end in
        (* ❌ Sequences of instructions are not handled (operator ";") *)
        let _ := equal None (Some Tez_repr.to_string) None vv vs in
        (* ❌ Sequences of instructions are not handled (operator ";") *)
        let _ := equal None (Some Tez_repr.to_string) None vv vs' in
        equal None (Some (fun s => s)) None (Tez_repr.to_string vv) s)
      known_ok_tez_literals in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    List.iter
      (fun s =>
        let vs := Tez_repr.of_string s in
        is_none (Some (op_caret "Unexpected successful parsing of " % string s))
          vs) known_bad_tez_literals in
  return_unit.

Definition test_random_tez_literals (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    (* ❌ For loops not handled. *)
    for in
  return_unit.

Definition tests {A : Type}
  : list
    (string *
      (A ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            unit))) :=
  cons
    ("tez-literals" % string,
      (fun function_parameter =>
        let '_ := function_parameter in
        test_known_tez_literals tt))
    (cons
      ("rnd-tez-literals" % string,
        (fun function_parameter =>
          let '_ := function_parameter in
          test_random_tez_literals tt)) []).

Definition wrap {A B C : Type}
  (function_parameter :
    A *
      (unit ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Pervasives.result unit
            B))) : C :=
  let '(n, f) := function_parameter in
  op_startypeminuserrorstar n
    (* ❌ Variants not supported *)
    variant
    (fun function_parameter =>
      let '_ := function_parameter in
      fun function_parameter =>
        let 'tt := function_parameter in
        op_gtgteq (f tt)
          (fun function_parameter =>
            match function_parameter with
            | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok tt =>
              Lwt.return_unit
            |
              Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                error =>
              Format.kasprintf Pervasives.failwith
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                  (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Alpha
                    Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                  "%a" % string) op_startypeminuserrorstar error
            end)).

Definition tests {A : Type} : list A := List.map wrap tests.
test/rolls.ml 220 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol
open Alpha_context
open Test_tez
open Test_utils

let account_pair = function [a1; a2] -> (a1, a2) | _ -> assert false

let wrap e = Lwt.return (Environment.wrap_error e)

let traverse_rolls ctxt head =
  let rec loop acc roll =
    Storage.Roll.Successor.get_option ctxt roll
    >>= wrap
    >>=? function
    | None -> return (List.rev acc) | Some next -> loop (next :: acc) next
  in
  loop [head] head

let get_rolls ctxt delegate =
  Storage.Roll.Delegate_roll_list.get_option ctxt delegate
  >>= wrap
  >>=? function
  | None -> return_nil | Some head_roll -> traverse_rolls ctxt head_roll

let check_rolls b (account : Account.t) =
  Context.get_constants (B b)
  >>=? fun constants ->
  Context.Delegate.info (B b) account.pkh
  >>=? fun {staking_balance; _} ->
  let token_per_roll = constants.parametric.tokens_per_roll in
  let expected_rolls =
    Int64.div (Tez.to_mutez staking_balance) (Tez.to_mutez token_per_roll)
  in
  Raw_context.prepare
    b.context
    ~level:b.header.shell.level
    ~predecessor_timestamp:b.header.shell.timestamp
    ~timestamp:b.header.shell.timestamp
    ~fitness:b.header.shell.fitness
  >>= wrap
  >>=? fun ctxt ->
  get_rolls ctxt account.pkh
  >>=? fun rolls ->
  Assert.equal_int
    ~loc:__LOC__
    (List.length rolls)
    (Int64.to_int expected_rolls)

let check_no_rolls (b : Block.t) (account : Account.t) =
  Raw_context.prepare
    b.context
    ~level:b.header.shell.level
    ~predecessor_timestamp:b.header.shell.timestamp
    ~timestamp:b.header.shell.timestamp
    ~fitness:b.header.shell.fitness
  >>= wrap
  >>=? fun ctxt ->
  get_rolls ctxt account.pkh
  >>=? fun rolls -> Assert.equal_int ~loc:__LOC__ (List.length rolls) 0

let simple_staking_rights () =
  Context.init 2
  >>=? fun (b, accounts) ->
  let (a1, _a2) = account_pair accounts in
  Context.Contract.balance (B b) a1
  >>=? fun balance ->
  Context.Contract.manager (B b) a1
  >>=? fun m1 ->
  Context.Delegate.info (B b) m1.pkh
  >>=? fun info ->
  Assert.equal_tez ~loc:__LOC__ balance info.staking_balance
  >>=? fun () -> check_rolls b m1

let simple_staking_rights_after_baking () =
  Context.init 2
  >>=? fun (b, accounts) ->
  let (a1, a2) = account_pair accounts in
  Context.Contract.balance (B b) a1
  >>=? fun balance ->
  Context.Contract.manager (B b) a1
  >>=? fun m1 ->
  Context.Contract.manager (B b) a2
  >>=? fun m2 ->
  Block.bake_n ~policy:(By_account m2.pkh) 5 b
  >>=? fun b ->
  Context.Delegate.info (B b) m1.pkh
  >>=? fun info ->
  Assert.equal_tez ~loc:__LOC__ balance info.staking_balance
  >>=? fun () -> check_rolls b m1 >>=? fun () -> check_rolls b m2

let frozen_deposit (info : Context.Delegate.info) =
  Cycle.Map.fold
    (fun _ {Delegate.deposit; _} acc -> Test_tez.Tez.(deposit + acc))
    info.frozen_balance_by_cycle
    Tez.zero

let check_activate_staking_balance ~loc ~deactivated b (a, (m : Account.t)) =
  Context.Delegate.info (B b) m.pkh
  >>=? fun info ->
  Assert.equal_bool ~loc info.deactivated deactivated
  >>=? fun () ->
  Context.Contract.balance (B b) a
  >>=? fun balance ->
  let deposit = frozen_deposit info in
  Assert.equal_tez ~loc Test_tez.Tez.(balance + deposit) info.staking_balance

let run_until_deactivation () =
  Context.init 2
  >>=? fun (b, accounts) ->
  let (a1, a2) = account_pair accounts in
  Context.Contract.balance (B b) a1
  >>=? fun balance_start ->
  Context.Contract.manager (B b) a1
  >>=? fun m1 ->
  Context.Contract.manager (B b) a2
  >>=? fun m2 ->
  check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b (a1, m1)
  >>=? fun () ->
  Context.Delegate.info (B b) m1.pkh
  >>=? fun info ->
  Block.bake_until_cycle ~policy:(By_account m2.pkh) info.grace_period b
  >>=? fun b ->
  check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b (a1, m1)
  >>=? fun () ->
  Block.bake_until_cycle_end ~policy:(By_account m2.pkh) b
  >>=? fun b ->
  check_activate_staking_balance ~loc:__LOC__ ~deactivated:true b (a1, m1)
  >>=? fun () -> return (b, ((a1, m1), balance_start), (a2, m2))

let deactivation_then_bake () =
  run_until_deactivation ()
  >>=? fun ( b,
             ( ((_deactivated_contract, deactivated_account) as deactivated),
               _start_balance ),
             (_a2, _m2) ) ->
  Block.bake ~policy:(By_account deactivated_account.pkh) b
  >>=? fun b ->
  check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b deactivated
  >>=? fun () -> check_rolls b deactivated_account

let deactivation_then_self_delegation () =
  run_until_deactivation ()
  >>=? fun ( b,
             ( ((deactivated_contract, deactivated_account) as deactivated),
               start_balance ),
             (_a2, m2) ) ->
  Op.delegation (B b) deactivated_contract (Some deactivated_account.pkh)
  >>=? fun self_delegation ->
  Block.bake ~policy:(By_account m2.pkh) b ~operation:self_delegation
  >>=? fun b ->
  check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b deactivated
  >>=? fun () ->
  Context.Contract.balance (B b) deactivated_contract
  >>=? fun balance ->
  Assert.equal_tez ~loc:__LOC__ start_balance balance
  >>=? fun () -> check_rolls b deactivated_account

let deactivation_then_empty_then_self_delegation () =
  run_until_deactivation ()
  >>=? fun ( b,
             ( ((deactivated_contract, deactivated_account) as deactivated),
               _start_balance ),
             (_a2, m2) ) ->
  (* empty the contract *)
  Context.Contract.balance (B b) deactivated_contract
  >>=? fun balance ->
  let sink_account = Account.new_account () in
  let sink_contract = Contract.implicit_contract sink_account.pkh in
  Context.get_constants (B b)
  >>=? fun {parametric = {origination_size; cost_per_byte; _}; _} ->
  Tez.(cost_per_byte *? Int64.of_int origination_size)
  >>?= fun origination_burn ->
  let amount =
    match Tez.(balance -? origination_burn) with
    | Ok r ->
        r
    | Error _ ->
        assert false
  in
  Op.transaction (B b) deactivated_contract sink_contract amount
  >>=? fun empty_contract ->
  Block.bake ~policy:(By_account m2.pkh) ~operation:empty_contract b
  >>=? fun b ->
  (* self delegation *)
  Op.delegation (B b) deactivated_contract (Some deactivated_account.pkh)
  >>=? fun self_delegation ->
  Block.bake ~policy:(By_account m2.pkh) ~operation:self_delegation b
  >>=? fun b ->
  check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b deactivated
  >>=? fun () ->
  Context.Contract.balance (B b) deactivated_contract
  >>=? fun balance ->
  Assert.equal_tez ~loc:__LOC__ Tez.zero balance
  >>=? fun () -> check_rolls b deactivated_account

let deactivation_then_empty_then_self_delegation_then_recredit () =
  run_until_deactivation ()
  >>=? fun ( b,
             ( ((deactivated_contract, deactivated_account) as deactivated),
               balance ),
             (_a2, m2) ) ->
  (* empty the contract *)
  let sink_account = Account.new_account () in
  let sink_contract = Contract.implicit_contract sink_account.pkh in
  Context.get_constants (B b)
  >>=? fun {parametric = {origination_size; cost_per_byte; _}; _} ->
  Tez.(cost_per_byte *? Int64.of_int origination_size)
  >>?= fun origination_burn ->
  let amount =
    match Tez.(balance -? origination_burn) with
    | Ok r ->
        r
    | Error _ ->
        assert false
  in
  Op.transaction (B b) deactivated_contract sink_contract amount
  >>=? fun empty_contract ->
  Block.bake ~policy:(By_account m2.pkh) ~operation:empty_contract b
  >>=? fun b ->
  (* self delegation *)
  Op.delegation (B b) deactivated_contract (Some deactivated_account.pkh)
  >>=? fun self_delegation ->
  Block.bake ~policy:(By_account m2.pkh) ~operation:self_delegation b
  >>=? fun b ->
  (* recredit *)
  Op.transaction (B b) sink_contract deactivated_contract amount
  >>=? fun recredit_contract ->
  Block.bake ~policy:(By_account m2.pkh) ~operation:recredit_contract b
  >>=? fun b ->
  check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b deactivated
  >>=? fun () ->
  Context.Contract.balance (B b) deactivated_contract
  >>=? fun balance ->
  Assert.equal_tez ~loc:__LOC__ amount balance
  >>=? fun () -> check_rolls b deactivated_account

let delegation () =
  Context.init 2
  >>=? fun (b, accounts) ->
  let (a1, a2) = account_pair accounts in
  let m3 = Account.new_account () in
  Account.add_account m3 ;
  Context.Contract.manager (B b) a1
  >>=? fun m1 ->
  Context.Contract.manager (B b) a2
  >>=? fun m2 ->
  let a3 = Contract.implicit_contract m3.pkh in
  Context.Contract.delegate_opt (B b) a1
  >>=? fun delegate ->
  ( match delegate with
  | None ->
      assert false
  | Some pkh ->
      assert (Signature.Public_key_hash.equal pkh m1.pkh) ) ;
  Op.transaction (B b) a1 a3 Tez.fifty_cents
  >>=? fun transact ->
  Block.bake ~policy:(By_account m2.pkh) b ~operation:transact
  >>=? fun b ->
  Context.Contract.delegate_opt (B b) a3
  >>=? fun delegate ->
  (match delegate with None -> () | Some _ -> assert false) ;
  check_no_rolls b m3
  >>=? fun () ->
  Op.delegation (B b) a3 (Some m3.pkh)
  >>=? fun delegation ->
  Block.bake ~policy:(By_account m2.pkh) b ~operation:delegation
  >>=? fun b ->
  Context.Contract.delegate_opt (B b) a3
  >>=? fun delegate ->
  ( match delegate with
  | None ->
      assert false
  | Some pkh ->
      assert (Signature.Public_key_hash.equal pkh m3.pkh) ) ;
  check_activate_staking_balance ~loc:__LOC__ ~deactivated:false b (a3, m3)
  >>=? fun () -> check_rolls b m3 >>=? fun () -> check_rolls b m1

let tests =
  [ Test.tztest "simple staking rights" `Quick simple_staking_rights;
    Test.tztest
      "simple staking rights after baking"
      `Quick
      simple_staking_rights_after_baking;
    Test.tztest "deactivation then bake" `Quick deactivation_then_bake;
    Test.tztest
      "deactivation then self delegation"
      `Quick
      deactivation_then_self_delegation;
    Test.tztest
      "deactivation then empty then self delegation"
      `Quick
      deactivation_then_empty_then_self_delegation;
    Test.tztest
      "deactivation then empty then self delegation then recredit"
      `Quick
      deactivation_then_empty_then_self_delegation_then_recredit;
    Test.tztest "delegation" `Quick delegation ]
rolls_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Protocol.

Import Alpha_context.

Definition account_pair {A : Type} (function_parameter : list A) : A * A :=
  match function_parameter with
  | cons a1 (cons a2 []) => (a1, a2)
  | _ =>
    (* ❌ Assert instruction is not handled. *)
    assert false
  end.

Definition wrap {A : Type}
  (e : Tezos_protocol_alpha.Protocol.Environment.Error_monad.tzresult A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_base__TzPervasives.Error_monad.tzresult A) :=
  Lwt.__return (Environment.wrap_error e).

Definition traverse_rolls
  (ctxt : Tezos_protocol_alpha.Protocol.Storage.Roll.Successor.context)
  (head : Tezos_protocol_alpha.Protocol.Storage.Roll.Successor.value)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list Tezos_protocol_alpha.Protocol.Storage.Roll.Successor.value)) :=
  let fix loop
    (acc : list Tezos_protocol_alpha.Protocol.Storage.Roll.Successor.value)
    (roll : Tezos_protocol_alpha.Protocol.Storage.Roll.Successor.key)
    : Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        (list Tezos_protocol_alpha.Protocol.Storage.Roll.Successor.value)) :=
    op_gtgteqquestion op_startypeminuserrorstar
      (fun function_parameter =>
        match function_parameter with
        | None => __return (List.rev acc)
        | Some next => loop (cons next acc) next
        end) in
  loop (cons head []) head.

Definition get_rolls
  (ctxt : Tezos_protocol_alpha.Protocol.Storage.Roll.Delegate_roll_list.context)
  (delegate : Tezos_protocol_alpha.Protocol.Storage.Roll.Delegate_roll_list.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list Tezos_protocol_alpha.Protocol.Storage.Roll.Successor.value)) :=
  op_gtgteqquestion op_startypeminuserrorstar
    (fun function_parameter =>
      match function_parameter with
      | None => return_nil
      | Some head_roll => traverse_rolls ctxt head_roll
      end).

Definition check_rolls {A B : Type} (b : A) (function_parameter : B)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let '_ := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
    (fun constants =>
      op_gtgteqquestion
        (op_startypeminuserrorstar op_startypeminuserrorstar
          (pkh op_startypeminuserrorstar))
        (fun function_parameter =>
          let '_ := function_parameter in
          let token_per_roll := tokens_per_roll (parametric constants) in
          let expected_rolls :=
            Int64.div (Tez.to_mutez op_startypeminuserrorstar)
              (Tez.to_mutez token_per_roll) in
          op_gtgteqquestion op_startypeminuserrorstar
            (fun ctxt =>
              op_gtgteqquestion (get_rolls ctxt (pkh op_startypeminuserrorstar))
                (fun rolls =>
                  op_startypeminuserrorstar __LOC__ (List.length rolls)
                    (Int64.to_int expected_rolls))))).

Definition check_no_rolls {A B : Type} (function_parameter : A)
  : B ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let '_ := function_parameter in
  fun function_parameter =>
    let '_ := function_parameter in
    op_gtgteqquestion op_startypeminuserrorstar
      (fun ctxt =>
        op_gtgteqquestion (get_rolls ctxt (pkh op_startypeminuserrorstar))
          (fun rolls => op_startypeminuserrorstar __LOC__ (List.length rolls) 0)).

Definition simple_staking_rights (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(b, accounts) := function_parameter in
      let '(a1, _a2) := account_pair accounts in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar a1)
        (fun balance =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar a1)
            (fun m1 =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar (pkh m1))
                (fun info =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar __LOC__ balance
                      (staking_balance info))
                    (fun function_parameter =>
                      let 'tt := function_parameter in
                      check_rolls b m1))))).

Definition simple_staking_rights_after_baking (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(b, accounts) := function_parameter in
      let '(a1, a2) := account_pair accounts in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar a1)
        (fun balance =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar a1)
            (fun m1 =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar a2)
                (fun m2 =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar 5 b)
                    (fun b =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          (pkh m1))
                        (fun info =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar __LOC__ balance
                              (staking_balance info))
                            (fun function_parameter =>
                              let 'tt := function_parameter in
                              op_gtgteqquestion (check_rolls b m1)
                                (fun function_parameter =>
                                  let 'tt := function_parameter in
                                  check_rolls b m2)))))))).

Definition frozen_deposit {A : Type} (function_parameter : A)
  : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez :=
  let '_ := function_parameter in
  Cycle.Map.fold
    (fun function_parameter =>
      let '_ := function_parameter in
      fun function_parameter =>
        let '{| Delegate.deposit := deposit |} := function_parameter in
        fun acc => op_startypeminuserrorstar)
    (frozen_balance_by_cycle op_startypeminuserrorstar) Tez.zero.

Definition check_activate_staking_balance {A B : Type}
  (loc : string) (deactivated : bool) (b : A)
  (function_parameter :
    Tezos_protocol_alpha.Protocol.Alpha_context.Contract.contract * B)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let '_ := function_parameter in
  op_gtgteqquestion
    (op_startypeminuserrorstar op_startypeminuserrorstar
      (pkh op_startypeminuserrorstar))
    (fun info =>
      op_gtgteqquestion
        (op_startypeminuserrorstar loc (deactivated info) deactivated)
        (fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar a)
            (fun balance =>
              let deposit := frozen_deposit info in
              op_startypeminuserrorstar loc op_startypeminuserrorstar
                (staking_balance info)))).

Definition run_until_deactivation {A B C D : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (A *
        ((Tezos_protocol_alpha.Protocol.Alpha_context.Contract.contract * B) * C)
        * (Tezos_protocol_alpha.Protocol.Alpha_context.Contract.contract * D))) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(b, accounts) := function_parameter in
      let '(a1, a2) := account_pair accounts in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar a1)
        (fun balance_start =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar a1)
            (fun m1 =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar a2)
                (fun m2 =>
                  op_gtgteqquestion
                    (check_activate_staking_balance __LOC__ false b (a1, m1))
                    (fun function_parameter =>
                      let 'tt := function_parameter in
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          (pkh m1))
                        (fun info =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar op_startypeminuserrorstar
                              (grace_period info) b)
                            (fun b =>
                              op_gtgteqquestion
                                (check_activate_staking_balance __LOC__ false b
                                  (a1, m1))
                                (fun function_parameter =>
                                  let 'tt := function_parameter in
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar
                                      op_startypeminuserrorstar b)
                                    (fun b =>
                                      op_gtgteqquestion
                                        (check_activate_staking_balance __LOC__
                                          true b (a1, m1))
                                        (fun function_parameter =>
                                          let 'tt := function_parameter in
                                          __return
                                            (b, ((a1, m1), balance_start),
                                              (a2, m2)))))))))))).

Definition deactivation_then_bake (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (run_until_deactivation tt)
    (fun function_parameter =>
      let
        '(b,
          ((_deactivated_contract, deactivated_account) as deactivated,
            _start_balance), (_a2, _m2)) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar b)
        (fun b =>
          op_gtgteqquestion
            (check_activate_staking_balance __LOC__ false b deactivated)
            (fun function_parameter =>
              let 'tt := function_parameter in
              check_rolls b deactivated_account))).

Definition deactivation_then_self_delegation (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (run_until_deactivation tt)
    (fun function_parameter =>
      let
        '(b,
          ((deactivated_contract, deactivated_account) as deactivated,
            start_balance), (_a2, m2)) := function_parameter in
      op_gtgteqquestion
        (op_startypeminuserrorstar op_startypeminuserrorstar
          deactivated_contract (Some (pkh deactivated_account)))
        (fun self_delegation =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar b
              self_delegation)
            (fun b =>
              op_gtgteqquestion
                (check_activate_staking_balance __LOC__ false b deactivated)
                (fun function_parameter =>
                  let 'tt := function_parameter in
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      deactivated_contract)
                    (fun balance =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar __LOC__ start_balance balance)
                        (fun function_parameter =>
                          let 'tt := function_parameter in
                          check_rolls b deactivated_account)))))).

Definition deactivation_then_empty_then_self_delegation {A : Type}
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (run_until_deactivation tt)
    (fun function_parameter =>
      let
        '(b,
          ((deactivated_contract, deactivated_account) as deactivated,
            _start_balance), (_a2, m2)) := function_parameter in
      op_gtgteqquestion
        (op_startypeminuserrorstar op_startypeminuserrorstar
          deactivated_contract)
        (fun balance =>
          let sink_account := op_startypeminuserrorstar tt in
          let sink_contract := Contract.implicit_contract (pkh sink_account) in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar)
            (fun function_parameter =>
              let '_ := function_parameter in
              op_startypeminuserrorstar
                (op_starquestion op_startypeminuserrorstar
                  (Int64.of_int op_startypeminuserrorstar))
                (fun origination_burn =>
                  let amount :=
                    match op_minusquestion balance origination_burn with
                    |
                      Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                        r => r
                    |
                      Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                        _ =>
                      (* ❌ Assert instruction is not handled. *)
                      assert false
                    end in
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      deactivated_contract sink_contract amount)
                    (fun empty_contract =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          empty_contract b)
                        (fun b =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar op_startypeminuserrorstar
                              deactivated_contract
                              (Some (pkh deactivated_account)))
                            (fun self_delegation =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar
                                  op_startypeminuserrorstar self_delegation b)
                                (fun b =>
                                  op_gtgteqquestion
                                    (check_activate_staking_balance __LOC__
                                      false b deactivated)
                                    (fun function_parameter =>
                                      let 'tt := function_parameter in
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar
                                          op_startypeminuserrorstar
                                          deactivated_contract)
                                        (fun balance =>
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar __LOC__
                                              Tez.zero balance)
                                            (fun function_parameter =>
                                              let 'tt := function_parameter in
                                              check_rolls b deactivated_account))))))))))).

Definition deactivation_then_empty_then_self_delegation_then_recredit {A : Type}
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (run_until_deactivation tt)
    (fun function_parameter =>
      let
        '(b,
          ((deactivated_contract, deactivated_account) as deactivated, balance),
          (_a2, m2)) := function_parameter in
      let sink_account := op_startypeminuserrorstar tt in
      let sink_contract := Contract.implicit_contract (pkh sink_account) in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
        (fun function_parameter =>
          let '_ := function_parameter in
          op_startypeminuserrorstar
            (op_starquestion op_startypeminuserrorstar
              (Int64.of_int op_startypeminuserrorstar))
            (fun origination_burn =>
              let amount :=
                match op_minusquestion balance origination_burn with
                | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok r
                  => r
                |
                  Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                    _ =>
                  (* ❌ Assert instruction is not handled. *)
                  assert false
                end in
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar
                  deactivated_contract sink_contract amount)
                (fun empty_contract =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      empty_contract b)
                    (fun b =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          deactivated_contract (Some (pkh deactivated_account)))
                        (fun self_delegation =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar op_startypeminuserrorstar
                              self_delegation b)
                            (fun b =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar
                                  op_startypeminuserrorstar sink_contract
                                  deactivated_contract amount)
                                (fun recredit_contract =>
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar
                                      op_startypeminuserrorstar
                                      recredit_contract b)
                                    (fun b =>
                                      op_gtgteqquestion
                                        (check_activate_staking_balance __LOC__
                                          false b deactivated)
                                        (fun function_parameter =>
                                          let 'tt := function_parameter in
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar
                                              op_startypeminuserrorstar
                                              deactivated_contract)
                                            (fun balance =>
                                              op_gtgteqquestion
                                                (op_startypeminuserrorstar
                                                  __LOC__ amount balance)
                                                (fun function_parameter =>
                                                  let 'tt := function_parameter
                                                    in
                                                  check_rolls b
                                                    deactivated_account)))))))))))).

Definition delegation (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(b, accounts) := function_parameter in
      let '(a1, a2) := account_pair accounts in
      let m3 := op_startypeminuserrorstar tt in
      (* ❌ Sequences of instructions are not handled (operator ";") *)
      let _ := op_startypeminuserrorstar m3 in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar a1)
        (fun m1 =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar a2)
            (fun m2 =>
              let a3 := Contract.implicit_contract (pkh m3) in
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar a1)
                (fun delegate =>
                  (* ❌ Sequences of instructions are not handled (operator ";") *)
                  let _ :=
                    match delegate with
                    | None =>
                      (* ❌ Assert instruction is not handled. *)
                      assert false
                    | Some pkh =>
                      (* ❌ Assert instruction is not handled. *)
                      assert (Signature.Public_key_hash.equal pkh (pkh m1))
                    end in
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar a1 a3
                      Tez.fifty_cents)
                    (fun transact =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar b
                          transact)
                        (fun b =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar op_startypeminuserrorstar
                              a3)
                            (fun delegate =>
                              (* ❌ Sequences of instructions are not handled (operator ";") *)
                              let _ :=
                                match delegate with
                                | None => tt
                                | Some _ =>
                                  (* ❌ Assert instruction is not handled. *)
                                  assert false
                                end in
                              op_gtgteqquestion (check_no_rolls b m3)
                                (fun function_parameter =>
                                  let 'tt := function_parameter in
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar
                                      op_startypeminuserrorstar a3
                                      (Some (pkh m3)))
                                    (fun delegation =>
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar
                                          op_startypeminuserrorstar b delegation)
                                        (fun b =>
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar
                                              op_startypeminuserrorstar a3)
                                            (fun delegate =>
                                              (* ❌ Sequences of instructions are not handled (operator ";") *)
                                              let _ :=
                                                match delegate with
                                                | None =>
                                                  (* ❌ Assert instruction is not handled. *)
                                                  assert false
                                                | Some pkh =>
                                                  (* ❌ Assert instruction is not handled. *)
                                                  assert
                                                    (Signature.Public_key_hash.equal
                                                      pkh (pkh m3))
                                                end in
                                              op_gtgteqquestion
                                                (check_activate_staking_balance
                                                  __LOC__ false b (a3, m3))
                                                (fun function_parameter =>
                                                  let 'tt := function_parameter
                                                    in
                                                  op_gtgteqquestion
                                                    (check_rolls b m3)
                                                    (fun function_parameter =>
                                                      let 'tt :=
                                                        function_parameter in
                                                      check_rolls b m1))))))))))))).

Definition tests {A : Type} : list A :=
  cons
    (op_startypeminuserrorstar "simple staking rights" % string
      (* ❌ Variants not supported *)
      variant simple_staking_rights)
    (cons
      (op_startypeminuserrorstar "simple staking rights after baking" % string
        (* ❌ Variants not supported *)
        variant simple_staking_rights_after_baking)
      (cons
        (op_startypeminuserrorstar "deactivation then bake" % string
          (* ❌ Variants not supported *)
          variant deactivation_then_bake)
        (cons
          (op_startypeminuserrorstar
            "deactivation then self delegation" % string
            (* ❌ Variants not supported *)
            variant deactivation_then_self_delegation)
          (cons
            (op_startypeminuserrorstar
              "deactivation then empty then self delegation" % string
              (* ❌ Variants not supported *)
              variant deactivation_then_empty_then_self_delegation)
            (cons
              (op_startypeminuserrorstar
                "deactivation then empty then self delegation then recredit" %
                  string
                (* ❌ Variants not supported *)
                variant
                deactivation_then_empty_then_self_delegation_then_recredit)
              (cons
                (op_startypeminuserrorstar "delegation" % string
                  (* ❌ Variants not supported *)
                  variant delegation) [])))))).
test/seed.ml 27 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Tests about
    - seed_nonce_hash included in some blocks
    - revelation operation of seed_nonce that should correspond to each
      seed_nonce_hash
*)

open Protocol
open Test_tez

(** Tests that baking [blocks_per_commitment] blocks without a
    [seed_nonce_hash] commitment fails with [Invalid_commitment] *)
let no_commitment () =
  Context.init 5
  >>=? fun (b, _) ->
  Context.get_constants (B b)
  >>=? fun {parametric = {blocks_per_commitment; _}; _} ->
  let blocks_per_commitment = Int32.to_int blocks_per_commitment in
  (* Bake normally until before the commitment *)
  Block.bake_n (blocks_per_commitment - 2) b
  >>=? fun b ->
  (* Forge a block with empty commitment and apply it *)
  Block.Forge.forge_header b
  >>=? fun header ->
  Block.Forge.set_seed_nonce_hash None header
  |> Block.Forge.sign_header
  >>=? fun header ->
  Block.apply header b
  >>= fun e ->
  Assert.proto_error ~loc:__LOC__ e (function
      | Apply.Invalid_commitment _ ->
          true
      | _ ->
          false)

let baking_reward ctxt (b : Block.t) =
  let priority = b.header.protocol_data.contents.priority in
  Block.get_endorsing_power b
  >>=? fun endorsing_power ->
  Context.get_baking_reward ctxt ~priority ~endorsing_power

(** Choose a baker, denote it by id. In the first cycle, make id bake only once.
    Test that:
    - after id bakes with a commitment the bond is frozen and the reward allocated
    - when id reveals the nonce too early, there's an error
    - when id reveals at the right time but the wrong value, there's an error
    - when another baker reveals correctly, it receives the tip
    - revealing twice produces an error
    - after [preserved cycles] a committer that correctly revealed
      receives back the bond and the reward
*)
let revelation_early_wrong_right_twice () =
  let open Assert in
  Context.init 5
  >>=? fun (b, _) ->
  Context.get_constants (B b)
  >>=? fun csts ->
  let bond = csts.parametric.block_security_deposit in
  let tip = csts.parametric.seed_nonce_revelation_tip in
  let blocks_per_commitment =
    Int32.to_int csts.parametric.blocks_per_commitment
  in
  let preserved_cycles = csts.parametric.preserved_cycles in
  (* get the pkh of a baker *)
  Block.get_next_baker b
  >>=? fun (pkh, _, _) ->
  let id = Alpha_context.Contract.implicit_contract pkh in
  let policy = Block.Excluding [pkh] in
  (* bake until commitment, excluding id *)
  Block.bake_n ~policy (blocks_per_commitment - 2) b
  >>=? fun b ->
  Context.Contract.balance ~kind:Main (B b) id
  >>=? fun bal_main ->
  Context.Contract.balance ~kind:Deposit (B b) id
  >>=? fun bal_deposit ->
  Context.Contract.balance ~kind:Rewards (B b) id
  >>=? fun bal_rewards ->
  (* the baker [id] will include a seed_nonce commitment *)
  Block.bake ~policy:(Block.By_account pkh) b
  >>=? fun b ->
  Context.get_level (B b)
  >>=? fun level_commitment ->
  Context.get_seed_nonce_hash (B b)
  >>=? fun committed_hash ->
  baking_reward (B b) b
  >>=? fun reward ->
  (* test that the bond was frozen and the reward allocated *)
  balance_was_debited ~loc:__LOC__ (B b) id bal_main bond
  >>=? fun () ->
  balance_was_credited ~loc:__LOC__ (B b) id ~kind:Deposit bal_deposit bond
  >>=? fun () ->
  balance_was_credited ~loc:__LOC__ (B b) id ~kind:Rewards bal_rewards reward
  >>=? fun () ->
  (* test that revealing too early produces an error *)
  Op.seed_nonce_revelation (B b) level_commitment (Nonce.get committed_hash)
  >>=? fun operation ->
  Block.bake ~policy ~operation b
  >>= fun e ->
  let expected = function
    | Nonce_storage.Too_early_revelation ->
        true
    | _ ->
        false
  in
  Assert.proto_error ~loc:__LOC__ e expected
  >>=? fun () ->
  (* finish the cycle excluding the committing baker, id *)
  Block.bake_until_cycle_end ~policy b
  >>=? fun b ->
  (* test that revealing at the right time but the wrong value produces an error *)
  let (wrong_hash, _) = Nonce.generate () in
  Op.seed_nonce_revelation (B b) level_commitment (Nonce.get wrong_hash)
  >>=? fun operation ->
  Block.bake ~operation b
  >>= fun e ->
  Assert.proto_error ~loc:__LOC__ e (function
      | Nonce_storage.Unexpected_nonce ->
          true
      | _ ->
          false)
  >>=? fun () ->
  (* reveals correctly *)
  Op.seed_nonce_revelation (B b) level_commitment (Nonce.get committed_hash)
  >>=? fun operation ->
  Block.get_next_baker ~policy b
  >>=? fun (baker_pkh, _, _) ->
  let baker = Alpha_context.Contract.implicit_contract baker_pkh in
  Context.Contract.balance ~kind:Main (B b) baker
  >>=? fun baker_bal_main ->
  Context.Contract.balance ~kind:Deposit (B b) baker
  >>=? fun baker_bal_deposit ->
  Context.Contract.balance ~kind:Rewards (B b) baker
  >>=? fun baker_bal_rewards ->
  (* bake the operation in a block *)
  Block.bake ~policy ~operation b
  >>=? fun b ->
  baking_reward (B b) b
  >>=? fun baker_reward ->
  (* test that the baker gets the tip reward *)
  balance_was_debited ~loc:__LOC__ (B b) baker ~kind:Main baker_bal_main bond
  >>=? fun () ->
  balance_was_credited
    ~loc:__LOC__
    (B b)
    baker
    ~kind:Deposit
    baker_bal_deposit
    bond
  >>=? fun () ->
  Lwt.return @@ Tez.( +? ) baker_reward tip
  >>=? fun expected_rewards ->
  balance_was_credited
    ~loc:__LOC__
    (B b)
    baker
    ~kind:Rewards
    baker_bal_rewards
    expected_rewards
  >>=? fun () ->
  (* test that revealing twice produces an error *)
  Op.seed_nonce_revelation (B b) level_commitment (Nonce.get wrong_hash)
  >>=? fun operation ->
  Block.bake ~operation ~policy b
  >>= fun e ->
  Assert.proto_error ~loc:__LOC__ e (function
      | Nonce_storage.Previously_revealed_nonce ->
          true
      | _ ->
          false)
  >>=? fun () ->
  (* bake [preserved_cycles] cycles excluding [id] *)
  Error_monad.fold_left_s
    (fun b _ -> Block.bake_until_cycle_end ~policy b)
    b
    (1 -- preserved_cycles)
  >>=? fun b ->
  (* test that [id] receives back the bond and the reward *)
  (* note that in order to have that new_bal = bal_main + reward,
     id can only bake once; this is why we exclude id from all other bake ops. *)
  balance_was_credited ~loc:__LOC__ (B b) id ~kind:Main bal_main reward
  >>=? fun () ->
  balance_is ~loc:__LOC__ (B b) id ~kind:Deposit Tez.zero
  >>=? fun () -> balance_is ~loc:__LOC__ (B b) id ~kind:Rewards Tez.zero

(** Tests that:
    - a committer at cycle 0, which doesn't reveal at cycle 1,
      at the end of the cycle 1 looses the bond and the reward
    - revealing too late produces an error
*)
let revelation_missing_and_late () =
  let open Context in
  let open Assert in
  Context.init 5
  >>=? fun (b, _) ->
  get_constants (B b)
  >>=? fun csts ->
  baking_reward (B b) b
  >>=? fun reward ->
  let blocks_per_commitment =
    Int32.to_int csts.parametric.blocks_per_commitment
  in
  (* bake until commitment *)
  Block.bake_n (blocks_per_commitment - 2) b
  >>=? fun b ->
  (* the next baker [id] will include a seed_nonce commitment *)
  Block.get_next_baker b
  >>=? fun (pkh, _, _) ->
  let id = Alpha_context.Contract.implicit_contract pkh in
  Block.bake b
  >>=? fun b ->
  Context.get_level (B b)
  >>=? fun level_commitment ->
  Context.get_seed_nonce_hash (B b)
  >>=? fun committed_hash ->
  Context.Contract.balance ~kind:Main (B b) id
  >>=? fun bal_main ->
  Context.Contract.balance ~kind:Deposit (B b) id
  >>=? fun bal_deposit ->
  Context.Contract.balance ~kind:Rewards (B b) id
  >>=? fun bal_rewards ->
  (* finish cycle 0 excluding the committing baker [id] *)
  let policy = Block.Excluding [pkh] in
  Block.bake_until_cycle_end ~policy b
  >>=? fun b ->
  (* finish cycle 1 excluding the committing baker [id] *)
  Block.bake_until_cycle_end ~policy b
  >>=? fun b ->
  (* test that baker [id], which didn't reveal at cycle 1 like it was supposed to,
     at the end of the cycle 1 looses the reward but not the bond *)
  balance_is ~loc:__LOC__ (B b) id ~kind:Main bal_main
  >>=? fun () ->
  balance_is ~loc:__LOC__ (B b) id ~kind:Deposit bal_deposit
  >>=? fun () ->
  balance_was_debited ~loc:__LOC__ (B b) id ~kind:Rewards bal_rewards reward
  >>=? fun () ->
  (* test that revealing too late (after cycle 1) produces an error *)
  Op.seed_nonce_revelation (B b) level_commitment (Nonce.get committed_hash)
  >>=? fun operation ->
  Block.bake ~operation b
  >>= fun e ->
  Assert.proto_error ~loc:__LOC__ e (function
      | Nonce_storage.Too_late_revelation ->
          true
      | _ ->
          false)

let tests =
  [ Test.tztest "no commitment" `Quick no_commitment;
    Test.tztest
      "revelation_early_wrong_right_twice"
      `Quick
      revelation_early_wrong_right_twice;
    Test.tztest
      "revelation_missing_and_late"
      `Quick
      revelation_missing_and_late ]
seed_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Protocol.

Definition no_commitment {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 5)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
        (fun function_parameter =>
          let '_ := function_parameter in
          let blocks_per_commitment := Int32.to_int op_startypeminuserrorstar in
          op_gtgteqquestion
            (op_startypeminuserrorstar (op_minus blocks_per_commitment 2) b)
            (fun b =>
              op_gtgteqquestion (op_startypeminuserrorstar b)
                (fun header =>
                  op_gtgteqquestion
                    (op_pipegt (op_startypeminuserrorstar None header)
                      op_startypeminuserrorstar)
                    (fun header =>
                      op_gtgteq (op_startypeminuserrorstar header b)
                        (fun e =>
                          op_startypeminuserrorstar __LOC__ e
                            (fun function_parameter =>
                              match function_parameter with
                              |
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Invalid_commitment
                                  _ => true
                              | _ => false
                              end))))))).

Definition baking_reward {A B C : Type} (ctxt : A) (function_parameter : B)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult C) :=
  let '_ := function_parameter in
  let priority :=
    priority (contents (protocol_data (header op_startypeminuserrorstar))) in
  op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
    (fun endorsing_power =>
      op_startypeminuserrorstar ctxt priority endorsing_power).

Definition revelation_early_wrong_right_twice {A : Type}
  (function_parameter : unit) : A :=
  let 'tt := function_parameter in
  op_startypeminuserrorstar.

Definition revelation_missing_and_late {A : Type} (function_parameter : unit)
  : A :=
  let 'tt := function_parameter in
  op_startypeminuserrorstar.

Definition tests {A : Type} : list A :=
  cons
    (op_startypeminuserrorstar "no commitment" % string
      (* ❌ Variants not supported *)
      variant no_commitment)
    (cons
      (op_startypeminuserrorstar "revelation_early_wrong_right_twice" % string
        (* ❌ Variants not supported *)
        variant revelation_early_wrong_right_twice)
      (cons
        (op_startypeminuserrorstar "revelation_missing_and_late" % string
          (* ❌ Variants not supported *)
          variant revelation_missing_and_late) [])).
test/test.ml 7 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(* Wraps an alcotest so that it prints correcly errors from the Error_monad. *)
let tztest name speed f =
  Alcotest_lwt.test_case name speed (fun _sw () ->
      f ()
      >>= function
      | Ok () ->
          Lwt.return_unit
      | Error err ->
          Tezos_stdlib_unix.Internal_event_unix.close ()
          >>= fun () ->
          Format.printf "@.%a@." pp_print_error err ;
          Lwt.fail Alcotest.Test_error)
test_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition tztest {A B C D : Type}
  (name : A) (speed : B)
  (f :
    unit ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Pervasives.result unit C))
  : D :=
  op_startypeminuserrorstar name speed
    (fun _sw =>
      fun function_parameter =>
        let 'tt := function_parameter in
        op_gtgteq (f tt)
          (fun function_parameter =>
            match function_parameter with
            | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok tt =>
              Lwt.return_unit
            | Tezos_protocol_environment_alpha__Environment.Pervasives.Error err
              =>
              op_gtgteq (Tezos_stdlib_unix.Internal_event_unix.close tt)
                (fun function_parameter =>
                  let 'tt := function_parameter in
                  (* ❌ Sequences of instructions are not handled (operator ";") *)
                  let _ :=
                    op_startypeminuserrorstar "@.%a@." % string
                      op_startypeminuserrorstar err in
                  op_startypeminuserrorstar op_startypeminuserrorstar)
            end)).
test/transfer.ml 270 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol
open Alpha_context
open Test_utils
open Test_tez

(*********************************************************************)
(* Utility functions                                                 *)
(*********************************************************************)

(**
   [transfer_and_check_balances b fee src dst amount]
   this function takes a block, an optional parameter fee if fee does not
   given it will be set to zero tez, a source contract, a destination contract
   and the amount that one wants to transfer.

   1- Transfer the amount of tez (w/wo fee) from a source contract to a
       destination contract.

    2- Check the equivalent of the balance of the source/destination
       contract before and after transfer is valided.

   This function returns a pair:
   - A block that added a valid operation
   - a valid operation
*)
let transfer_and_check_balances ?(with_burn = false) ~loc b ?(fee = Tez.zero)
    ?expect_failure src dst amount =
  Tez.( +? ) fee amount
  >>?= fun amount_fee ->
  Context.Contract.balance (I b) src
  >>=? fun bal_src ->
  Context.Contract.balance (I b) dst
  >>=? fun bal_dst ->
  Op.transaction (I b) ~fee src dst amount
  >>=? fun op ->
  Incremental.add_operation ?expect_failure b op
  >>=? fun b ->
  Context.get_constants (I b)
  >>=? fun {parametric = {origination_size; cost_per_byte; _}; _} ->
  Tez.(cost_per_byte *? Int64.of_int origination_size)
  >>?= fun origination_burn ->
  let amount_fee_maybe_burn =
    if with_burn then
      match Tez.(amount_fee +? origination_burn) with
      | Ok r ->
          r
      | Error _ ->
          assert false
    else amount_fee
  in
  Assert.balance_was_debited ~loc (I b) src bal_src amount_fee_maybe_burn
  >>=? fun () ->
  Assert.balance_was_credited ~loc (I b) dst bal_dst amount
  >>=? fun () -> return (b, op)

(**
   [transfer_to_itself_and_check_balances b fee contract amount]
   this function takes a block, an optional parameter fee,
   a contract that is a source and a destination contract,
   and an amount of tez that one wants to transfer.

   1- Transfer the amount of tez (w/wo transfer fee) from/to a contract itself.

   2- Check the equivalent of the balance of the contract before
       and after transfer.

   This function returns a pair:
   - a block that added the valid transaction
   - an valid transaction
*)
let transfer_to_itself_and_check_balances ~loc b ?(fee = Tez.zero) contract
    amount =
  Context.Contract.balance (I b) contract
  >>=? fun bal ->
  Op.transaction (I b) ~fee contract contract amount
  >>=? fun op ->
  Incremental.add_operation b op
  >>=? fun b ->
  Assert.balance_was_debited ~loc (I b) contract bal fee
  >>=? fun () -> return (b, op)

(**
   [n_transactions n b fee source dest amount]
   this function takes a number of "n" that one wish to transfer,
   a block, an optional parameter fee, a source contract,
   a destination contract and an amount one wants to transfer.

   This function will do a transaction from a source contract to
   a destination contract with the amount "n" times.
*)
let n_transactions n b ?fee source dest amount =
  fold_left_s
    (fun b _ ->
      transfer_and_check_balances ~loc:__LOC__ b ?fee source dest amount
      >>=? fun (b, _) -> return b)
    b
    (1 -- n)

let ten_tez = Tez.of_int 10

(*********************************************************************)
(* Tests                                                             *)
(*********************************************************************)

let register_two_contracts () =
  Context.init 2
  >>=? fun (b, contracts) ->
  let contract_1 = List.nth contracts 0 in
  let contract_2 = List.nth contracts 1 in
  return (b, contract_1, contract_2)

(** compute half of the balance and divided by nth
    times *)

let two_nth_of_balance incr contract nth =
  Context.Contract.balance (I incr) contract
  >>=? fun balance ->
  Tez.( /? ) balance nth
  >>?= fun res -> Tez.( *? ) res 2L >>?= fun balance -> return balance

(********************)
(** Single transfer *)

(********************)

let single_transfer ?fee ?expect_failure amount =
  register_two_contracts ()
  >>=? fun (b, contract_1, contract_2) ->
  Incremental.begin_construction b
  >>=? fun b ->
  transfer_and_check_balances
    ~loc:__LOC__
    ?fee
    ?expect_failure
    b
    contract_1
    contract_2
    amount
  >>=? fun (b, _) -> Incremental.finalize_block b >>=? fun _ -> return_unit

(** single transfer without fee *)
let block_with_a_single_transfer () = single_transfer Tez.one

(** single transfer with fee *)
let block_with_a_single_transfer_with_fee () =
  single_transfer ~fee:Tez.one Tez.one

(** single transfer without fee *)

let transfer_zero_tez () =
  single_transfer
    ~expect_failure:(function
      | Environment.Ecoproto_error (Contract_storage.Empty_transaction _) :: _
        ->
          return_unit
      | _ ->
          failwith "Empty transaction should fail")
    Tez.zero

(********************)
(** Transfer zero tez from an implicit contract *)

(********************)

let transfer_zero_implicit () =
  Context.init 1
  >>=? fun (b, contracts) ->
  let dest = List.nth contracts 0 in
  let account = Account.new_account () in
  Incremental.begin_construction b
  >>=? fun i ->
  let src = Contract.implicit_contract account.Account.pkh in
  Op.transaction (I i) src dest Tez.zero
  >>=? fun op ->
  Incremental.add_operation i op
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Contract_storage.Empty_implicit_contract _ ->
          true
      | _ ->
          false)

(********************)
(** Transfer to originted contract *)

(********************)

let transfer_to_originate_with_fee () =
  Context.init 1
  >>=? fun (b, contracts) ->
  let contract = List.nth contracts 0 in
  Incremental.begin_construction b
  >>=? fun b ->
  two_nth_of_balance b contract 10L
  >>=? fun fee ->
  (* originated contract, paying a fee to originated this contract *)
  Op.origination (I b) ~fee:ten_tez contract ~script:Op.dummy_script
  >>=? fun (operation, new_contract) ->
  Incremental.add_operation b operation
  >>=? fun b ->
  two_nth_of_balance b contract 3L
  >>=? fun amount ->
  transfer_and_check_balances ~loc:__LOC__ b ~fee contract new_contract amount
  >>=? fun (b, _) -> Incremental.finalize_block b >>=? fun _ -> return_unit

(********************)
(** Transfer from balance *)

(********************)

let transfer_amount_of_contract_balance () =
  register_two_contracts ()
  >>=? fun (b, contract_1, contract_2) ->
  Context.Contract.pkh contract_1
  >>=? fun pkh1 ->
  (* given that contract_1 no longer has a sufficient balance to bake,
     make sure it cannot be chosen as baker *)
  Incremental.begin_construction b ~policy:(Block.Excluding [pkh1])
  >>=? fun b ->
  (* get the balance of the source contract *)
  Context.Contract.balance (I b) contract_1
  >>=? fun balance ->
  (* transfer all the tez inside contract 1 *)
  transfer_and_check_balances ~loc:__LOC__ b contract_1 contract_2 balance
  >>=? fun (b, _) -> Incremental.finalize_block b >>=? fun _ -> return_unit

(********************)
(** Transfer to itself *)

(********************)

let transfers_to_self () =
  Context.init 1
  >>=? fun (b, contracts) ->
  let contract = List.nth contracts 0 in
  Incremental.begin_construction b
  >>=? fun b ->
  two_nth_of_balance b contract 3L
  >>=? fun amount ->
  transfer_to_itself_and_check_balances ~loc:__LOC__ b contract amount
  >>=? fun (b, _) ->
  two_nth_of_balance b contract 5L
  >>=? fun fee ->
  transfer_to_itself_and_check_balances ~loc:__LOC__ b ~fee contract ten_tez
  >>=? fun (b, _) -> Incremental.finalize_block b >>=? fun _ -> return_unit

(********************)
(** Forgot to add the valid transaction into the block *)

(********************)

let missing_transaction () =
  register_two_contracts ()
  >>=? fun (b, contract_1, contract_2) ->
  (* given that contract_1 no longer has a sufficient balance to bake,
     make sure it cannot be chosen as baker *)
  Context.Contract.pkh contract_1
  >>=? fun pkh1 ->
  Incremental.begin_construction b ~policy:(Block.Excluding [pkh1])
  >>=? fun b ->
  two_nth_of_balance b contract_1 6L
  >>=? fun amount ->
  (* do the transfer 3 times from source contract to destination contract *)
  n_transactions 3 b contract_1 contract_2 amount
  >>=? fun b ->
  (* do the fourth transfer from source contract to destination contract *)
  Op.transaction (I b) contract_1 contract_2 amount
  >>=? fun _ -> Incremental.finalize_block b >>=? fun _ -> return_unit

(********************)
(** These following tests are for different kind of contracts:
    - implicit to implicit
    - implicit to originated
    - originated to implicit
    - originted to originted *)

(********************)

(** Implicit to Implicit *)

let transfer_from_implicit_to_implicit_contract () =
  Context.init 1
  >>=? fun (b, contracts) ->
  let bootstrap_contract = List.nth contracts 0 in
  let account_a = Account.new_account () in
  let account_b = Account.new_account () in
  Incremental.begin_construction b
  >>=? fun b ->
  let src = Contract.implicit_contract account_a.Account.pkh in
  two_nth_of_balance b bootstrap_contract 3L
  >>=? fun amount1 ->
  two_nth_of_balance b bootstrap_contract 10L
  >>=? fun fee1 ->
  transfer_and_check_balances
    ~with_burn:true
    ~loc:__LOC__
    ~fee:fee1
    b
    bootstrap_contract
    src
    amount1
  >>=? fun (b, _) ->
  (* create an implicit contract as a destination contract *)
  let dest = Contract.implicit_contract account_b.pkh in
  two_nth_of_balance b bootstrap_contract 4L
  >>=? fun amount2 ->
  two_nth_of_balance b bootstrap_contract 10L
  >>=? fun fee2 ->
  (* transfer from implicit contract to another implicit contract *)
  transfer_and_check_balances
    ~with_burn:true
    ~loc:__LOC__
    ~fee:fee2
    b
    src
    dest
    amount2
  >>=? fun (b, _) -> Incremental.finalize_block b >>=? fun _ -> return_unit

(** Implicit to originated *)

let transfer_from_implicit_to_originated_contract () =
  Context.init 1
  >>=? fun (b, contracts) ->
  let bootstrap_contract = List.nth contracts 0 in
  let contract = List.nth contracts 0 in
  let account = Account.new_account () in
  let src = Contract.implicit_contract account.Account.pkh in
  Incremental.begin_construction b
  >>=? fun b ->
  two_nth_of_balance b bootstrap_contract 3L
  >>=? fun amount1 ->
  (* transfer the money to implicit contract *)
  transfer_and_check_balances
    ~with_burn:true
    ~loc:__LOC__
    b
    bootstrap_contract
    src
    amount1
  >>=? fun (b, _) ->
  (* originated contract *)
  Op.origination (I b) contract ~script:Op.dummy_script
  >>=? fun (operation, new_contract) ->
  Incremental.add_operation b operation
  >>=? fun b ->
  two_nth_of_balance b bootstrap_contract 4L
  >>=? fun amount2 ->
  (* transfer from implicit contract to originated contract *)
  transfer_and_check_balances ~loc:__LOC__ b src new_contract amount2
  >>=? fun (b, _) -> Incremental.finalize_block b >>=? fun _ -> return_unit

(********************)
(** Slow tests case *)

(********************)

let multiple_transfer n ?fee amount =
  register_two_contracts ()
  >>=? fun (b, contract_1, contract_2) ->
  Incremental.begin_construction b
  >>=? fun b ->
  n_transactions n b ?fee contract_1 contract_2 amount
  >>=? fun b -> Incremental.finalize_block b >>=? fun _ -> return_unit

(** 1- Create a block with two contracts;
    2- Apply 100 transfers. *)
let block_with_multiple_transfers () = multiple_transfer 99 (Tez.of_int 1000)

(** 1- Create a block with two contracts;
    2- Apply 100 transfers with 10tz fee. *)
let block_with_multiple_transfers_pay_fee () =
  multiple_transfer 10 ~fee:ten_tez (Tez.of_int 1000)

(* TODO : increase the number of operations and add a `Slow tag to it in `tests` *)

(** 1- Create a block with 8 contracts;
    2- Apply multiple transfers without fees;
    3- Apply multiple transfers with fees. *)
let block_with_multiple_transfers_with_without_fee () =
  Context.init 8
  >>=? fun (b, contracts) ->
  let contracts = Array.of_list contracts in
  Incremental.begin_construction b
  >>=? fun b ->
  let hundred = Tez.of_int 100 in
  let ten = Tez.of_int 10 in
  let twenty = Tez.of_int 20 in
  n_transactions 10 b contracts.(0) contracts.(1) Tez.one
  >>=? fun b ->
  n_transactions 30 b contracts.(1) contracts.(2) hundred
  >>=? fun b ->
  n_transactions 30 b contracts.(1) contracts.(3) hundred
  >>=? fun b ->
  n_transactions 30 b contracts.(4) contracts.(3) hundred
  >>=? fun b ->
  n_transactions 20 b contracts.(0) contracts.(1) hundred
  >>=? fun b ->
  n_transactions 10 b contracts.(1) contracts.(3) hundred
  >>=? fun b ->
  n_transactions 10 b contracts.(1) contracts.(3) hundred
  >>=? fun b ->
  n_transactions 20 ~fee:ten b contracts.(3) contracts.(4) ten
  >>=? fun b ->
  n_transactions 10 ~fee:twenty b contracts.(4) contracts.(5) ten
  >>=? fun b ->
  n_transactions 70 ~fee:twenty b contracts.(6) contracts.(0) twenty
  >>=? fun b ->
  n_transactions 550 ~fee:twenty b contracts.(6) contracts.(4) twenty
  >>=? fun b ->
  n_transactions 50 ~fee:ten b contracts.(7) contracts.(5) twenty
  >>=? fun b ->
  n_transactions 30 ~fee:ten b contracts.(0) contracts.(7) hundred
  >>=? fun b ->
  n_transactions 20 ~fee:ten b contracts.(1) contracts.(0) twenty
  >>=? fun b -> Incremental.finalize_block b >>=? fun _ -> return_unit

(********************)
(** Build a chain that has 10 blocks. *)

(********************)

let build_a_chain () =
  register_two_contracts ()
  >>=? fun (b, contract_1, contract_2) ->
  let ten = Tez.of_int 10 in
  fold_left_s
    (fun b _ ->
      Incremental.begin_construction b
      >>=? fun b ->
      transfer_and_check_balances ~loc:__LOC__ b contract_1 contract_2 ten
      >>=? fun (b, _) -> Incremental.finalize_block b)
    b
    (1 -- 10)
  >>=? fun _ -> return_unit

(*********************************************************************)
(* Expected error test cases                                         *)
(*********************************************************************)

(********************)
(** transfer zero tez is forbidden in implicit contract *)

(********************)

let empty_implicit () =
  Context.init 1
  >>=? fun (b, contracts) ->
  let dest = List.nth contracts 0 in
  let account = Account.new_account () in
  Incremental.begin_construction b
  >>=? fun incr ->
  let src = Contract.implicit_contract account.Account.pkh in
  two_nth_of_balance incr dest 3L
  >>=? fun amount ->
  (* transfer zero tez from an implicit contract *)
  Op.transaction (I incr) src dest amount
  >>=? fun op ->
  Incremental.add_operation incr op
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Contract_storage.Empty_implicit_contract _ ->
          true
      | _ ->
          false)

(********************)
(** Balance is too low to transfer *)

(********************)

let balance_too_low fee () =
  register_two_contracts ()
  >>=? fun (b, contract_1, contract_2) ->
  Incremental.begin_construction b
  >>=? fun i ->
  Context.Contract.balance (I i) contract_1
  >>=? fun balance1 ->
  Context.Contract.balance (I i) contract_2
  >>=? fun balance2 ->
  (* transfer the amount of tez that is bigger than the balance in the source contract *)
  Op.transaction ~fee (I i) contract_1 contract_2 Tez.max_tez
  >>=? fun op ->
  let expect_failure = function
    | Environment.Ecoproto_error (Contract_storage.Balance_too_low _) :: _ ->
        return_unit
    | _ ->
        failwith "balance too low should fail"
  in
  (* the fee is higher than the balance then raise an error "Balance_too_low" *)
  if fee > balance1 then
    Incremental.add_operation ~expect_failure i op >>= fun _res -> return_unit
    (* the fee is smaller than the balance, then the transfer is accepted
     but it is not processed, and fees are taken *)
  else
    Incremental.add_operation ~expect_failure i op
    >>=? fun i ->
    (* contract_1 loses the fees *)
    Assert.balance_was_debited ~loc:__LOC__ (I i) contract_1 balance1 fee
    >>=? fun () ->
    (* contract_2 is not credited *)
    Assert.balance_was_credited ~loc:__LOC__ (I i) contract_2 balance2 Tez.zero

(** 1- Create a block, and three contracts;
    2- Add a transfer that at the end the balance of a contract is
       zero into this block;
    3- Add another transfer that send tez from a zero balance contract;
    4- Catch the expected error: Balance_too_low. *)
let balance_too_low_two_transfers fee () =
  Context.init 3
  >>=? fun (b, contracts) ->
  let contract_1 = List.nth contracts 0 in
  let contract_2 = List.nth contracts 1 in
  let contract_3 = List.nth contracts 2 in
  Incremental.begin_construction b
  >>=? fun i ->
  Context.Contract.balance (I i) contract_1
  >>=? fun balance ->
  Tez.( /? ) balance 3L
  >>?= fun res ->
  Tez.( *? ) res 2L
  >>?= fun two_third_of_balance ->
  transfer_and_check_balances
    ~loc:__LOC__
    i
    contract_1
    contract_2
    two_third_of_balance
  >>=? fun (i, _) ->
  Context.Contract.balance (I i) contract_1
  >>=? fun balance1 ->
  Context.Contract.balance (I i) contract_3
  >>=? fun balance3 ->
  Op.transaction ~fee (I i) contract_1 contract_3 two_third_of_balance
  >>=? fun operation ->
  let expect_failure = function
    | Environment.Ecoproto_error (Contract_storage.Balance_too_low _) :: _ ->
        return_unit
    | _ ->
        failwith "balance too low should fail"
  in
  Incremental.add_operation ~expect_failure i operation
  >>=? fun i ->
  (* contract_1 loses the fees *)
  Assert.balance_was_debited ~loc:__LOC__ (I i) contract_1 balance1 fee
  >>=? fun () ->
  (* contract_3 is not credited *)
  Assert.balance_was_credited ~loc:__LOC__ (I i) contract_3 balance3 Tez.zero

(********************)
(** The counter is already used for the previous operation *)

(********************)

let invalid_counter () =
  register_two_contracts ()
  >>=? fun (b, contract_1, contract_2) ->
  Incremental.begin_construction b
  >>=? fun b ->
  Op.transaction (I b) contract_1 contract_2 Tez.one
  >>=? fun op1 ->
  Op.transaction (I b) contract_1 contract_2 Tez.one
  >>=? fun op2 ->
  Incremental.add_operation b op1
  >>=? fun b ->
  Incremental.add_operation b op2
  >>= fun b ->
  Assert.proto_error ~loc:__LOC__ b (function
      | Contract_storage.Counter_in_the_past _ ->
          true
      | _ ->
          false)

(* same as before but different way to perform this error *)

let add_the_same_operation_twice () =
  register_two_contracts ()
  >>=? fun (b, contract_1, contract_2) ->
  Incremental.begin_construction b
  >>=? fun b ->
  transfer_and_check_balances ~loc:__LOC__ b contract_1 contract_2 ten_tez
  >>=? fun (b, op_transfer) ->
  Op.transaction (I b) contract_1 contract_2 ten_tez
  >>=? fun _ ->
  Incremental.add_operation b op_transfer
  >>= fun b ->
  Assert.proto_error ~loc:__LOC__ b (function
      | Contract_storage.Counter_in_the_past _ ->
          true
      | _ ->
          false)

(********************)
(** check ownership *)

(********************)

let ownership_sender () =
  register_two_contracts ()
  >>=? fun (b, contract_1, contract_2) ->
  Incremental.begin_construction b
  >>=? fun b ->
  (* get the manager of the contract_1 as a sender *)
  Context.Contract.manager (I b) contract_1
  >>=? fun manager ->
  (* create an implicit_contract *)
  let imcontract_1 = Alpha_context.Contract.implicit_contract manager.pkh in
  transfer_and_check_balances ~loc:__LOC__ b imcontract_1 contract_2 Tez.one
  >>=? fun (b, _) -> Incremental.finalize_block b >>=? fun _ -> return_unit

(*********************************************************************)
(** Random transfer *)

(** Return a pair of minimum and maximum random number *)
let random_range (min, max) =
  let interv = max - min + 1 in
  let init =
    Random.self_init () ;
    Random.int interv + min
  in
  init

(** Return a random contract *)
let random_contract contract_array =
  let i = Random.int (Array.length contract_array) in
  contract_array.(i)

(** Transfer by randomly choose amount 10 contracts, and randomly
    choose the amount in the source contract *)
let random_transfer () =
  Context.init 10
  >>=? fun (b, contracts) ->
  let contracts = Array.of_list contracts in
  let source = random_contract contracts in
  let dest = random_contract contracts in
  Context.Contract.pkh source
  >>=? fun source_pkh ->
  (* given that source may not have a sufficient balance for the transfer + to bake,
     make sure it cannot be chosen as baker *)
  Incremental.begin_construction b ~policy:(Block.Excluding [source_pkh])
  >>=? fun b ->
  Context.Contract.balance (I b) source
  >>=? fun amount ->
  ( if source = dest then
    transfer_to_itself_and_check_balances ~loc:__LOC__ b source amount
  else transfer_and_check_balances ~loc:__LOC__ b source dest amount )
  >>=? fun (b, _) -> Incremental.finalize_block b >>=? fun _ -> return_unit

(** Transfer random transactions *)
let random_multi_transactions () =
  let n = random_range (1, 100) in
  multiple_transfer n (Tez.of_int 100)

(*********************************************************************)

let tests =
  [ (* single transfer *)
    Test.tztest "single transfer" `Quick block_with_a_single_transfer;
    Test.tztest
      "single transfer with fee"
      `Quick
      block_with_a_single_transfer_with_fee;
    (* transfer zero tez *)
    Test.tztest "single transfer zero tez" `Quick transfer_zero_tez;
    Test.tztest
      "transfer zero tez from implicit contract"
      `Quick
      transfer_zero_implicit;
    (* transfer to originated contract *)
    Test.tztest
      "transfer to originated contract paying transaction fee"
      `Quick
      transfer_to_originate_with_fee;
    (* transfer by the balance of contract *)
    Test.tztest
      "transfer the amount from source contract balance"
      `Quick
      transfer_amount_of_contract_balance;
    (* transfer to itself *)
    Test.tztest "transfers to itself" `Quick transfers_to_self;
    (* missing operation *)
    Test.tztest "missing transaction" `Quick missing_transaction;
    (* transfer from/to implicit/originted contracts*)
    Test.tztest
      "transfer from an implicit to implicit contract "
      `Quick
      transfer_from_implicit_to_implicit_contract;
    Test.tztest
      "transfer from an implicit to an originated contract"
      `Quick
      transfer_from_implicit_to_originated_contract;
    (* Slow tests *)
    Test.tztest
      "block with multiple transfers"
      `Slow
      block_with_multiple_transfers;
    (* TODO increase the number of transaction times *)
    Test.tztest
      "block with multiple transfer paying fee"
      `Slow
      block_with_multiple_transfers_pay_fee;
    Test.tztest
      "block with multiple transfer without paying fee"
      `Slow
      block_with_multiple_transfers_with_without_fee;
    (* build the chain *)
    Test.tztest "build a chain" `Quick build_a_chain;
    (* Erroneous *)
    Test.tztest "empty implicit" `Quick empty_implicit;
    Test.tztest
      "balance too low - transfer zero"
      `Quick
      (balance_too_low Tez.zero);
    Test.tztest "balance too low" `Quick (balance_too_low Tez.one);
    Test.tztest
      "balance too low (max fee)"
      `Quick
      (balance_too_low Tez.max_tez);
    Test.tztest
      "balance too low with two transfers - transfer zero"
      `Quick
      (balance_too_low_two_transfers Tez.zero);
    Test.tztest
      "balance too low with two transfers"
      `Quick
      (balance_too_low_two_transfers Tez.one);
    Test.tztest "invalid_counter" `Quick invalid_counter;
    Test.tztest
      "add the same operation twice"
      `Quick
      add_the_same_operation_twice;
    Test.tztest "ownership sender" `Quick ownership_sender;
    (* Random tests *)
    Test.tztest "random transfer" `Quick random_transfer;
    Test.tztest "random multi transfer" `Quick random_multi_transactions ]
transfer_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Protocol.

Import Alpha_context.

Definition transfer_and_check_balances {A B C D E F : Type}
  (op_staroptstar : option bool)
  : A ->
    B ->
      option Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez ->
        option C ->
          D -> E -> Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez -> F :=
  let with_burn :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => false
    end in
  fun loc =>
    fun b =>
      fun op_staroptstar =>
        let fee :=
          match op_staroptstar with
          | Some op_starsthstar => op_starsthstar
          | None => Tez.zero
          end in
        fun expect_failure =>
          fun src =>
            fun dst =>
              fun amount =>
                op_startypeminuserrorstar (Tez.op_plusquestion fee amount)
                  (fun amount_fee =>
                    op_gtgteqquestion
                      (op_startypeminuserrorstar op_startypeminuserrorstar src)
                      (fun bal_src =>
                        op_gtgteqquestion
                          (op_startypeminuserrorstar op_startypeminuserrorstar
                            dst)
                          (fun bal_dst =>
                            op_gtgteqquestion
                              (op_startypeminuserrorstar
                                op_startypeminuserrorstar fee src dst amount)
                              (fun op =>
                                op_gtgteqquestion
                                  (op_startypeminuserrorstar expect_failure b op)
                                  (fun b =>
                                    op_gtgteqquestion
                                      (op_startypeminuserrorstar
                                        op_startypeminuserrorstar)
                                      (fun function_parameter =>
                                        let '_ := function_parameter in
                                        op_startypeminuserrorstar
                                          (op_starquestion
                                            op_startypeminuserrorstar
                                            (Int64.of_int
                                              op_startypeminuserrorstar))
                                          (fun origination_burn =>
                                            let amount_fee_maybe_burn :=
                                              if with_burn then
                                                match
                                                  op_plusquestion amount_fee
                                                    origination_burn with
                                                |
                                                  Tezos_protocol_environment_alpha__Environment.Pervasives.Ok
                                                    r => r
                                                |
                                                  Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                                                    _ =>
                                                  (* ❌ Assert instruction is not handled. *)
                                                  assert false
                                                end
                                              else
                                                amount_fee in
                                            op_gtgteqquestion
                                              (op_startypeminuserrorstar loc
                                                op_startypeminuserrorstar src
                                                bal_src amount_fee_maybe_burn)
                                              (fun function_parameter =>
                                                let 'tt := function_parameter in
                                                op_gtgteqquestion
                                                  (op_startypeminuserrorstar loc
                                                    op_startypeminuserrorstar
                                                    dst bal_dst amount)
                                                  (fun function_parameter =>
                                                    let 'tt :=
                                                      function_parameter in
                                                    __return (b, op)))))))))).

Definition transfer_to_itself_and_check_balances {A B C D E F : Type}
  (loc : A) (b : B)
  (op_staroptstar : option Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez)
  : C ->
    D ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          (E * F)) :=
  let fee :=
    match op_staroptstar with
    | Some op_starsthstar => op_starsthstar
    | None => Tez.zero
    end in
  fun contract =>
    fun amount =>
      op_gtgteqquestion
        (op_startypeminuserrorstar op_startypeminuserrorstar contract)
        (fun bal =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar fee contract
              contract amount)
            (fun op =>
              op_gtgteqquestion (op_startypeminuserrorstar b op)
                (fun b =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar loc op_startypeminuserrorstar
                      contract bal fee)
                    (fun function_parameter =>
                      let 'tt := function_parameter in
                      __return (b, op))))).

Definition n_transactions {A B C D : Type}
  (n : A) (b : B)
  (fee : option Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez)
  (source : C) (dest : D)
  (amount : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
  fold_left_s
    (fun b =>
      fun function_parameter =>
        let '_ := function_parameter in
        op_gtgteqquestion
          (transfer_and_check_balances None __LOC__ b fee None source dest
            amount)
          (fun function_parameter =>
            let '(b, _) := function_parameter in
            __return b)) b (op_startypeminuserrorstar 1 n).

Definition ten_tez {A : Type} : A := op_startypeminuserrorstar 10.

Definition register_two_contracts {A B C : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (A * B * C)) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 2)
    (fun function_parameter =>
      let '(b, contracts) := function_parameter in
      let contract_1 := op_startypeminuserrorstar contracts 0 in
      let contract_2 := op_startypeminuserrorstar contracts 1 in
      __return (b, contract_1, contract_2)).

Definition two_nth_of_balance {A B C : Type}
  (incr : A) (contract : B) (nth : int64)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult C) :=
  op_gtgteqquestion
    (op_startypeminuserrorstar op_startypeminuserrorstar contract)
    (fun balance =>
      op_startypeminuserrorstar (Tez.op_divquestion balance nth)
        (fun res =>
          op_startypeminuserrorstar
            (Tez.op_starquestion res
              (* ❌ Constant of type int64 is converted to int *)
              2) (fun balance => __return balance))).

Definition single_transfer {A : Type}
  (fee : option Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez)
  (expect_failure : option A)
  (amount : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  op_gtgteqquestion (register_two_contracts tt)
    (fun function_parameter =>
      let '(b, contract_1, contract_2) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun b =>
          op_gtgteqquestion
            (transfer_and_check_balances None __LOC__ b fee expect_failure
              contract_1 contract_2 amount)
            (fun function_parameter =>
              let '(b, _) := function_parameter in
              op_gtgteqquestion (op_startypeminuserrorstar b)
                (fun function_parameter =>
                  let '_ := function_parameter in
                  return_unit)))).

Definition block_with_a_single_transfer (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  single_transfer None None Tez.one.

Definition block_with_a_single_transfer_with_fee (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  single_transfer (Some Tez.one) None Tez.one.

Definition transfer_zero_tez (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  single_transfer None
    (Some
      (fun function_parameter =>
        match function_parameter with
        |
          cons
            (Tezos_base__TzPervasives.Error_monad.Ecoproto_error
              (Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_transaction
                _)) _ => return_unit
        | _ => failwith "Empty transaction should fail" % string
        end)) Tez.zero.

Definition transfer_zero_implicit {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, contracts) := function_parameter in
      let dest := op_startypeminuserrorstar contracts 0 in
      let account := op_startypeminuserrorstar tt in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          let src := Contract.implicit_contract (Account.pkh account) in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar src dest
              Tez.zero)
            (fun op =>
              op_gtgteq (op_startypeminuserrorstar i op)
                (fun res =>
                  op_startypeminuserrorstar __LOC__ res
                    (fun function_parameter =>
                      match function_parameter with
                      |
                        Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_implicit_contract
                          _ => true
                      | _ => false
                      end))))).

Definition transfer_to_originate_with_fee (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, contracts) := function_parameter in
      let contract := op_startypeminuserrorstar contracts 0 in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun b =>
          op_gtgteqquestion
            (two_nth_of_balance b contract
              (* ❌ Constant of type int64 is converted to int *)
              10)
            (fun fee =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar ten_tez
                  contract op_startypeminuserrorstar)
                (fun function_parameter =>
                  let '(operation, new_contract) := function_parameter in
                  op_gtgteqquestion (op_startypeminuserrorstar b operation)
                    (fun b =>
                      op_gtgteqquestion
                        (two_nth_of_balance b contract
                          (* ❌ Constant of type int64 is converted to int *)
                          3)
                        (fun amount =>
                          op_gtgteqquestion
                            (transfer_and_check_balances None __LOC__ b
                              (Some fee) None contract new_contract amount)
                            (fun function_parameter =>
                              let '(b, _) := function_parameter in
                              op_gtgteqquestion (op_startypeminuserrorstar b)
                                (fun function_parameter =>
                                  let '_ := function_parameter in
                                  return_unit)))))))).

Definition transfer_amount_of_contract_balance (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (register_two_contracts tt)
    (fun function_parameter =>
      let '(b, contract_1, contract_2) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar contract_1)
        (fun pkh1 =>
          op_gtgteqquestion
            (op_startypeminuserrorstar b op_startypeminuserrorstar)
            (fun b =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar contract_1)
                (fun balance =>
                  op_gtgteqquestion
                    (transfer_and_check_balances None __LOC__ b None None
                      contract_1 contract_2 balance)
                    (fun function_parameter =>
                      let '(b, _) := function_parameter in
                      op_gtgteqquestion (op_startypeminuserrorstar b)
                        (fun function_parameter =>
                          let '_ := function_parameter in
                          return_unit)))))).

Definition transfers_to_self (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, contracts) := function_parameter in
      let contract := op_startypeminuserrorstar contracts 0 in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun b =>
          op_gtgteqquestion
            (two_nth_of_balance b contract
              (* ❌ Constant of type int64 is converted to int *)
              3)
            (fun amount =>
              op_gtgteqquestion
                (transfer_to_itself_and_check_balances __LOC__ b None contract
                  amount)
                (fun function_parameter =>
                  let '(b, _) := function_parameter in
                  op_gtgteqquestion
                    (two_nth_of_balance b contract
                      (* ❌ Constant of type int64 is converted to int *)
                      5)
                    (fun fee =>
                      op_gtgteqquestion
                        (transfer_to_itself_and_check_balances __LOC__ b
                          (Some fee) contract ten_tez)
                        (fun function_parameter =>
                          let '(b, _) := function_parameter in
                          op_gtgteqquestion (op_startypeminuserrorstar b)
                            (fun function_parameter =>
                              let '_ := function_parameter in
                              return_unit))))))).

Definition missing_transaction (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (register_two_contracts tt)
    (fun function_parameter =>
      let '(b, contract_1, contract_2) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar contract_1)
        (fun pkh1 =>
          op_gtgteqquestion
            (op_startypeminuserrorstar b op_startypeminuserrorstar)
            (fun b =>
              op_gtgteqquestion
                (two_nth_of_balance b contract_1
                  (* ❌ Constant of type int64 is converted to int *)
                  6)
                (fun amount =>
                  op_gtgteqquestion
                    (n_transactions 3 b None contract_1 contract_2 amount)
                    (fun b =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar
                          contract_1 contract_2 amount)
                        (fun function_parameter =>
                          let '_ := function_parameter in
                          op_gtgteqquestion (op_startypeminuserrorstar b)
                            (fun function_parameter =>
                              let '_ := function_parameter in
                              return_unit))))))).

Definition transfer_from_implicit_to_implicit_contract
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, contracts) := function_parameter in
      let bootstrap_contract := op_startypeminuserrorstar contracts 0 in
      let account_a := op_startypeminuserrorstar tt in
      let account_b := op_startypeminuserrorstar tt in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun b =>
          let src := Contract.implicit_contract (Account.pkh account_a) in
          op_gtgteqquestion
            (two_nth_of_balance b bootstrap_contract
              (* ❌ Constant of type int64 is converted to int *)
              3)
            (fun amount1 =>
              op_gtgteqquestion
                (two_nth_of_balance b bootstrap_contract
                  (* ❌ Constant of type int64 is converted to int *)
                  10)
                (fun fee1 =>
                  op_gtgteqquestion
                    (transfer_and_check_balances (Some true) __LOC__ b
                      (Some fee1) None bootstrap_contract src amount1)
                    (fun function_parameter =>
                      let '(b, _) := function_parameter in
                      let dest := Contract.implicit_contract (pkh account_b) in
                      op_gtgteqquestion
                        (two_nth_of_balance b bootstrap_contract
                          (* ❌ Constant of type int64 is converted to int *)
                          4)
                        (fun amount2 =>
                          op_gtgteqquestion
                            (two_nth_of_balance b bootstrap_contract
                              (* ❌ Constant of type int64 is converted to int *)
                              10)
                            (fun fee2 =>
                              op_gtgteqquestion
                                (transfer_and_check_balances (Some true) __LOC__
                                  b (Some fee2) None src dest amount2)
                                (fun function_parameter =>
                                  let '(b, _) := function_parameter in
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar b)
                                    (fun function_parameter =>
                                      let '_ := function_parameter in
                                      return_unit))))))))).

Definition transfer_from_implicit_to_originated_contract
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, contracts) := function_parameter in
      let bootstrap_contract := op_startypeminuserrorstar contracts 0 in
      let contract := op_startypeminuserrorstar contracts 0 in
      let account := op_startypeminuserrorstar tt in
      let src := Contract.implicit_contract (Account.pkh account) in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun b =>
          op_gtgteqquestion
            (two_nth_of_balance b bootstrap_contract
              (* ❌ Constant of type int64 is converted to int *)
              3)
            (fun amount1 =>
              op_gtgteqquestion
                (transfer_and_check_balances (Some true) __LOC__ b None None
                  bootstrap_contract src amount1)
                (fun function_parameter =>
                  let '(b, _) := function_parameter in
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      contract op_startypeminuserrorstar)
                    (fun function_parameter =>
                      let '(operation, new_contract) := function_parameter in
                      op_gtgteqquestion (op_startypeminuserrorstar b operation)
                        (fun b =>
                          op_gtgteqquestion
                            (two_nth_of_balance b bootstrap_contract
                              (* ❌ Constant of type int64 is converted to int *)
                              4)
                            (fun amount2 =>
                              op_gtgteqquestion
                                (transfer_and_check_balances None __LOC__ b None
                                  None src new_contract amount2)
                                (fun function_parameter =>
                                  let '(b, _) := function_parameter in
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar b)
                                    (fun function_parameter =>
                                      let '_ := function_parameter in
                                      return_unit))))))))).

Definition multiple_transfer {A : Type}
  (n : A) (fee : option Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez)
  (amount : Tezos_protocol_alpha.Protocol.Alpha_context.Tez.tez)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  op_gtgteqquestion (register_two_contracts tt)
    (fun function_parameter =>
      let '(b, contract_1, contract_2) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun b =>
          op_gtgteqquestion
            (n_transactions n b fee contract_1 contract_2 amount)
            (fun b =>
              op_gtgteqquestion (op_startypeminuserrorstar b)
                (fun function_parameter =>
                  let '_ := function_parameter in
                  return_unit)))).

Definition block_with_multiple_transfers (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  multiple_transfer 99 None (op_startypeminuserrorstar 1000).

Definition block_with_multiple_transfers_pay_fee (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  multiple_transfer 10 (Some ten_tez) (op_startypeminuserrorstar 1000).

Definition block_with_multiple_transfers_with_without_fee
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 8)
    (fun function_parameter =>
      let '(b, contracts) := function_parameter in
      let contracts := op_startypeminuserrorstar contracts in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun b =>
          let hundred := op_startypeminuserrorstar 100 in
          let ten := op_startypeminuserrorstar 10 in
          let twenty := op_startypeminuserrorstar 20 in
          op_gtgteqquestion
            (n_transactions 10 b None (op_startypeminuserrorstar contracts 0)
              (op_startypeminuserrorstar contracts 1) Tez.one)
            (fun b =>
              op_gtgteqquestion
                (n_transactions 30 b None
                  (op_startypeminuserrorstar contracts 1)
                  (op_startypeminuserrorstar contracts 2) hundred)
                (fun b =>
                  op_gtgteqquestion
                    (n_transactions 30 b None
                      (op_startypeminuserrorstar contracts 1)
                      (op_startypeminuserrorstar contracts 3) hundred)
                    (fun b =>
                      op_gtgteqquestion
                        (n_transactions 30 b None
                          (op_startypeminuserrorstar contracts 4)
                          (op_startypeminuserrorstar contracts 3) hundred)
                        (fun b =>
                          op_gtgteqquestion
                            (n_transactions 20 b None
                              (op_startypeminuserrorstar contracts 0)
                              (op_startypeminuserrorstar contracts 1) hundred)
                            (fun b =>
                              op_gtgteqquestion
                                (n_transactions 10 b None
                                  (op_startypeminuserrorstar contracts 1)
                                  (op_startypeminuserrorstar contracts 3)
                                  hundred)
                                (fun b =>
                                  op_gtgteqquestion
                                    (n_transactions 10 b None
                                      (op_startypeminuserrorstar contracts 1)
                                      (op_startypeminuserrorstar contracts 3)
                                      hundred)
                                    (fun b =>
                                      op_gtgteqquestion
                                        (n_transactions 20 b (Some ten)
                                          (op_startypeminuserrorstar contracts 3)
                                          (op_startypeminuserrorstar contracts 4)
                                          ten)
                                        (fun b =>
                                          op_gtgteqquestion
                                            (n_transactions 10 b (Some twenty)
                                              (op_startypeminuserrorstar
                                                contracts 4)
                                              (op_startypeminuserrorstar
                                                contracts 5) ten)
                                            (fun b =>
                                              op_gtgteqquestion
                                                (n_transactions 70 b
                                                  (Some twenty)
                                                  (op_startypeminuserrorstar
                                                    contracts 6)
                                                  (op_startypeminuserrorstar
                                                    contracts 0) twenty)
                                                (fun b =>
                                                  op_gtgteqquestion
                                                    (n_transactions 550 b
                                                      (Some twenty)
                                                      (op_startypeminuserrorstar
                                                        contracts 6)
                                                      (op_startypeminuserrorstar
                                                        contracts 4) twenty)
                                                    (fun b =>
                                                      op_gtgteqquestion
                                                        (n_transactions 50 b
                                                          (Some ten)
                                                          (op_startypeminuserrorstar
                                                            contracts 7)
                                                          (op_startypeminuserrorstar
                                                            contracts 5) twenty)
                                                        (fun b =>
                                                          op_gtgteqquestion
                                                            (n_transactions 30 b
                                                              (Some ten)
                                                              (op_startypeminuserrorstar
                                                                contracts 0)
                                                              (op_startypeminuserrorstar
                                                                contracts 7)
                                                              hundred)
                                                            (fun b =>
                                                              op_gtgteqquestion
                                                                (n_transactions
                                                                  20 b
                                                                  (Some ten)
                                                                  (op_startypeminuserrorstar
                                                                    contracts 1)
                                                                  (op_startypeminuserrorstar
                                                                    contracts 0)
                                                                  twenty)
                                                                (fun b =>
                                                                  op_gtgteqquestion
                                                                    (op_startypeminuserrorstar
                                                                      b)
                                                                    (fun
                                                                      function_parameter
                                                                      =>
                                                                      let '_ :=
                                                                        function_parameter
                                                                        in
                                                                      return_unit))))))))))))))))).

Definition build_a_chain (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (register_two_contracts tt)
    (fun function_parameter =>
      let '(b, contract_1, contract_2) := function_parameter in
      let ten := op_startypeminuserrorstar 10 in
      op_gtgteqquestion
        (fold_left_s
          (fun b =>
            fun function_parameter =>
              let '_ := function_parameter in
              op_gtgteqquestion (op_startypeminuserrorstar b)
                (fun b =>
                  op_gtgteqquestion
                    (transfer_and_check_balances None __LOC__ b None None
                      contract_1 contract_2 ten)
                    (fun function_parameter =>
                      let '(b, _) := function_parameter in
                      op_startypeminuserrorstar b))) b
          (op_startypeminuserrorstar 1 10))
        (fun function_parameter =>
          let '_ := function_parameter in
          return_unit)).

Definition empty_implicit {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, contracts) := function_parameter in
      let dest := op_startypeminuserrorstar contracts 0 in
      let account := op_startypeminuserrorstar tt in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun incr =>
          let src := Contract.implicit_contract (Account.pkh account) in
          op_gtgteqquestion
            (two_nth_of_balance incr dest
              (* ❌ Constant of type int64 is converted to int *)
              3)
            (fun amount =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar src dest
                  amount)
                (fun op =>
                  op_gtgteq (op_startypeminuserrorstar incr op)
                    (fun res =>
                      op_startypeminuserrorstar __LOC__ res
                        (fun function_parameter =>
                          match function_parameter with
                          |
                            Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_implicit_contract
                              _ => true
                          | _ => false
                          end)))))).

Definition balance_too_low {A : Type} (fee : A) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (register_two_contracts tt)
    (fun function_parameter =>
      let '(b, contract_1, contract_2) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar contract_1)
            (fun balance1 =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar contract_2)
                (fun balance2 =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar fee op_startypeminuserrorstar
                      contract_1 contract_2 op_startypeminuserrorstar)
                    (fun op =>
                      let expect_failure
                        (function_parameter :
                        list Tezos_base__TzPervasives.Error_monad.error)
                        : Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                            unit) :=
                        match function_parameter with
                        |
                          cons
                            (Tezos_base__TzPervasives.Error_monad.Ecoproto_error
                              (Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                _ _ _)) _ => return_unit
                        | _ => failwith "balance too low should fail" % string
                        end in
                      if op_startypeminuserrorstar fee balance1 then
                        op_gtgteq
                          (op_startypeminuserrorstar expect_failure i op)
                          (fun _res => return_unit)
                      else
                        op_gtgteqquestion
                          (op_startypeminuserrorstar expect_failure i op)
                          (fun i =>
                            op_gtgteqquestion
                              (op_startypeminuserrorstar __LOC__
                                op_startypeminuserrorstar contract_1 balance1
                                fee)
                              (fun function_parameter =>
                                let 'tt := function_parameter in
                                op_startypeminuserrorstar __LOC__
                                  op_startypeminuserrorstar contract_2 balance2
                                  Tez.zero))))))).

Definition balance_too_low_two_transfers {A B : Type}
  (fee : A) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult B) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 3)
    (fun function_parameter =>
      let '(b, contracts) := function_parameter in
      let contract_1 := op_startypeminuserrorstar contracts 0 in
      let contract_2 := op_startypeminuserrorstar contracts 1 in
      let contract_3 := op_startypeminuserrorstar contracts 2 in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun i =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar contract_1)
            (fun balance =>
              op_startypeminuserrorstar
                (Tez.op_divquestion balance
                  (* ❌ Constant of type int64 is converted to int *)
                  3)
                (fun res =>
                  op_startypeminuserrorstar
                    (Tez.op_starquestion res
                      (* ❌ Constant of type int64 is converted to int *)
                      2)
                    (fun two_third_of_balance =>
                      op_gtgteqquestion
                        (transfer_and_check_balances None __LOC__ i None None
                          contract_1 contract_2 two_third_of_balance)
                        (fun function_parameter =>
                          let '(i, _) := function_parameter in
                          op_gtgteqquestion
                            (op_startypeminuserrorstar op_startypeminuserrorstar
                              contract_1)
                            (fun balance1 =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar
                                  op_startypeminuserrorstar contract_3)
                                (fun balance3 =>
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar fee
                                      op_startypeminuserrorstar contract_1
                                      contract_3 two_third_of_balance)
                                    (fun operation =>
                                      let expect_failure
                                        (function_parameter :
                                        list
                                          Tezos_base__TzPervasives.Error_monad.error)
                                        : Tezos_protocol_environment_alpha__Environment.Lwt.t
                                          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
                                            unit) :=
                                        match function_parameter with
                                        |
                                          cons
                                            (Tezos_base__TzPervasives.Error_monad.Ecoproto_error
                                              (Tezos_protocol_environment_alpha__Environment.Error_monad.Balance_too_low
                                                _ _ _)) _ => return_unit
                                        | _ =>
                                          failwith
                                            "balance too low should fail" %
                                              string
                                        end in
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar
                                          expect_failure i operation)
                                        (fun i =>
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar __LOC__
                                              op_startypeminuserrorstar
                                              contract_1 balance1 fee)
                                            (fun function_parameter =>
                                              let 'tt := function_parameter in
                                              op_startypeminuserrorstar __LOC__
                                                op_startypeminuserrorstar
                                                contract_3 balance3 Tez.zero))))))))))).

Definition invalid_counter {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (register_two_contracts tt)
    (fun function_parameter =>
      let '(b, contract_1, contract_2) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun b =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar contract_1
              contract_2 Tez.one)
            (fun op1 =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar contract_1
                  contract_2 Tez.one)
                (fun op2 =>
                  op_gtgteqquestion (op_startypeminuserrorstar b op1)
                    (fun b =>
                      op_gtgteq (op_startypeminuserrorstar b op2)
                        (fun b =>
                          op_startypeminuserrorstar __LOC__ b
                            (fun function_parameter =>
                              match function_parameter with
                              |
                                Tezos_protocol_environment_alpha__Environment.Error_monad.Counter_in_the_past
                                  _ _ _ => true
                              | _ => false
                              end))))))).

Definition add_the_same_operation_twice {A : Type} (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (register_two_contracts tt)
    (fun function_parameter =>
      let '(b, contract_1, contract_2) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun b =>
          op_gtgteqquestion
            (transfer_and_check_balances None __LOC__ b None None contract_1
              contract_2 ten_tez)
            (fun function_parameter =>
              let '(b, op_transfer) := function_parameter in
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar contract_1
                  contract_2 ten_tez)
                (fun function_parameter =>
                  let '_ := function_parameter in
                  op_gtgteq (op_startypeminuserrorstar b op_transfer)
                    (fun b =>
                      op_startypeminuserrorstar __LOC__ b
                        (fun function_parameter =>
                          match function_parameter with
                          |
                            Tezos_protocol_environment_alpha__Environment.Error_monad.Counter_in_the_past
                              _ _ _ => true
                          | _ => false
                          end)))))).

Definition ownership_sender (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (register_two_contracts tt)
    (fun function_parameter =>
      let '(b, contract_1, contract_2) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar b)
        (fun b =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar contract_1)
            (fun manager =>
              let imcontract_1 :=
                Alpha_context.Contract.implicit_contract (pkh manager) in
              op_gtgteqquestion
                (transfer_and_check_balances None __LOC__ b None None
                  imcontract_1 contract_2 Tez.one)
                (fun function_parameter =>
                  let '(b, _) := function_parameter in
                  op_gtgteqquestion (op_startypeminuserrorstar b)
                    (fun function_parameter =>
                      let '_ := function_parameter in
                      return_unit))))).

Definition random_range (function_parameter : Z * Z) : Z :=
  let '(min, max) := function_parameter in
  let interv := op_plus (op_minus max min) 1 in
  let init :=
    (* ❌ Sequences of instructions are not handled (operator ";") *)
    let _ := op_startypeminuserrorstar tt in
    op_plus (op_startypeminuserrorstar interv) min in
  init.

Definition random_contract {A B : Type} (contract_array : A) : B :=
  let i := op_startypeminuserrorstar (op_startypeminuserrorstar contract_array)
    in
  op_startypeminuserrorstar contract_array i.

Definition random_transfer (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 10)
    (fun function_parameter =>
      let '(b, contracts) := function_parameter in
      let contracts := op_startypeminuserrorstar contracts in
      let source := random_contract contracts in
      let dest := random_contract contracts in
      op_gtgteqquestion (op_startypeminuserrorstar source)
        (fun source_pkh =>
          op_gtgteqquestion
            (op_startypeminuserrorstar b op_startypeminuserrorstar)
            (fun b =>
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar source)
                (fun amount =>
                  op_gtgteqquestion
                    (if op_startypeminuserrorstar source dest then
                      transfer_to_itself_and_check_balances __LOC__ b None
                        source amount
                    else
                      transfer_and_check_balances None __LOC__ b None None
                        source dest amount)
                    (fun function_parameter =>
                      let '(b, _) := function_parameter in
                      op_gtgteqquestion (op_startypeminuserrorstar b)
                        (fun function_parameter =>
                          let '_ := function_parameter in
                          return_unit)))))).

Definition random_multi_transactions (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  let n := random_range (1, 100) in
  multiple_transfer n None (op_startypeminuserrorstar 100).

Definition tests {A : Type} : list A :=
  cons
    (op_startypeminuserrorstar "single transfer" % string
      (* ❌ Variants not supported *)
      variant block_with_a_single_transfer)
    (cons
      (op_startypeminuserrorstar "single transfer with fee" % string
        (* ❌ Variants not supported *)
        variant block_with_a_single_transfer_with_fee)
      (cons
        (op_startypeminuserrorstar "single transfer zero tez" % string
          (* ❌ Variants not supported *)
          variant transfer_zero_tez)
        (cons
          (op_startypeminuserrorstar
            "transfer zero tez from implicit contract" % string
            (* ❌ Variants not supported *)
            variant transfer_zero_implicit)
          (cons
            (op_startypeminuserrorstar
              "transfer to originated contract paying transaction fee" % string
              (* ❌ Variants not supported *)
              variant transfer_to_originate_with_fee)
            (cons
              (op_startypeminuserrorstar
                "transfer the amount from source contract balance" % string
                (* ❌ Variants not supported *)
                variant transfer_amount_of_contract_balance)
              (cons
                (op_startypeminuserrorstar "transfers to itself" % string
                  (* ❌ Variants not supported *)
                  variant transfers_to_self)
                (cons
                  (op_startypeminuserrorstar "missing transaction" % string
                    (* ❌ Variants not supported *)
                    variant missing_transaction)
                  (cons
                    (op_startypeminuserrorstar
                      "transfer from an implicit to implicit contract " % string
                      (* ❌ Variants not supported *)
                      variant transfer_from_implicit_to_implicit_contract)
                    (cons
                      (op_startypeminuserrorstar
                        "transfer from an implicit to an originated contract" %
                          string
                        (* ❌ Variants not supported *)
                        variant transfer_from_implicit_to_originated_contract)
                      (cons
                        (op_startypeminuserrorstar
                          "block with multiple transfers" % string
                          (* ❌ Variants not supported *)
                          variant block_with_multiple_transfers)
                        (cons
                          (op_startypeminuserrorstar
                            "block with multiple transfer paying fee" % string
                            (* ❌ Variants not supported *)
                            variant block_with_multiple_transfers_pay_fee)
                          (cons
                            (op_startypeminuserrorstar
                              "block with multiple transfer without paying fee"
                                % string
                              (* ❌ Variants not supported *)
                              variant
                              block_with_multiple_transfers_with_without_fee)
                            (cons
                              (op_startypeminuserrorstar
                                "build a chain" % string
                                (* ❌ Variants not supported *)
                                variant build_a_chain)
                              (cons
                                (op_startypeminuserrorstar
                                  "empty implicit" % string
                                  (* ❌ Variants not supported *)
                                  variant empty_implicit)
                                (cons
                                  (op_startypeminuserrorstar
                                    "balance too low - transfer zero" % string
                                    (* ❌ Variants not supported *)
                                    variant (balance_too_low Tez.zero))
                                  (cons
                                    (op_startypeminuserrorstar
                                      "balance too low" % string
                                      (* ❌ Variants not supported *)
                                      variant (balance_too_low Tez.one))
                                    (cons
                                      (op_startypeminuserrorstar
                                        "balance too low (max fee)" % string
                                        (* ❌ Variants not supported *)
                                        variant
                                        (balance_too_low
                                          op_startypeminuserrorstar))
                                      (cons
                                        (op_startypeminuserrorstar
                                          "balance too low with two transfers - transfer zero"
                                            % string
                                          (* ❌ Variants not supported *)
                                          variant
                                          (balance_too_low_two_transfers
                                            Tez.zero))
                                        (cons
                                          (op_startypeminuserrorstar
                                            "balance too low with two transfers"
                                              % string
                                            (* ❌ Variants not supported *)
                                            variant
                                            (balance_too_low_two_transfers
                                              Tez.one))
                                          (cons
                                            (op_startypeminuserrorstar
                                              "invalid_counter" % string
                                              (* ❌ Variants not supported *)
                                              variant invalid_counter)
                                            (cons
                                              (op_startypeminuserrorstar
                                                "add the same operation twice" %
                                                  string
                                                (* ❌ Variants not supported *)
                                                variant
                                                add_the_same_operation_twice)
                                              (cons
                                                (op_startypeminuserrorstar
                                                  "ownership sender" % string
                                                  (* ❌ Variants not supported *)
                                                  variant ownership_sender)
                                                (cons
                                                  (op_startypeminuserrorstar
                                                    "random transfer" % string
                                                    (* ❌ Variants not supported *)
                                                    variant random_transfer)
                                                  (cons
                                                    (op_startypeminuserrorstar
                                                      "random multi transfer" %
                                                        string
                                                      (* ❌ Variants not supported *)
                                                      variant
                                                      random_multi_transactions)
                                                    [])))))))))))))))))))))))).
test/voting.ml 523 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Protocol
open Test_utils

(* missing stuff in Alpha_context.Vote *)
let ballots_zero = Alpha_context.Vote.{yay = 0l; nay = 0l; pass = 0l}

let ballots_equal b1 b2 =
  Alpha_context.Vote.(b1.yay = b2.yay && b1.nay = b2.nay && b1.pass = b2.pass)

let ballots_pp ppf v =
  Alpha_context.Vote.(
    Format.fprintf
      ppf
      "{ yay = %ld ; nay = %ld ; pass = %ld"
      v.yay
      v.nay
      v.pass)

(* constants and ratios used in voting:
   percent_mul denotes the percent multiplier
   initial_participation is 7000 that is, 7/10 * percent_mul
   the participation EMA ratio pr_ema_weight / den = 7 / 10
   the participation ratio pr_num / den = 2 / 10
   note: we use the same denominator for both participation EMA and participation rate.
   supermajority rate is s_num / s_den = 8 / 10 *)
let percent_mul = 100_00

let initial_participation_num = 7

let initial_participation = initial_participation_num * percent_mul / 10

let pr_ema_weight = 8

let den = 10

let pr_num = den - pr_ema_weight

let s_num = 8

let s_den = 10

let qr_min_num = 2

let qr_max_num = 7

let expected_qr_num =
  Float.(
    of_int qr_min_num
    +. of_int initial_participation_num
       *. (of_int qr_max_num -. of_int qr_min_num)
       /. of_int den)

(* Protocol_hash.zero is "PrihK96nBAFSxVL1GLJTVhu9YnzkMFiBeuJRPA8NwuZVZCE1L6i" *)
let protos =
  Array.map
    (fun s -> Protocol_hash.of_b58check_exn s)
    [| "ProtoALphaALphaALphaALphaALphaALphaALpha61322gcLUGH";
       "ProtoALphaALphaALphaALphaALphaALphaALphabc2a7ebx6WB";
       "ProtoALphaALphaALphaALphaALphaALphaALpha84efbeiF6cm";
       "ProtoALphaALphaALphaALphaALphaALphaALpha91249Z65tWS";
       "ProtoALphaALphaALphaALphaALphaALphaALpha537f5h25LnN";
       "ProtoALphaALphaALphaALphaALphaALphaALpha5c8fefgDYkr";
       "ProtoALphaALphaALphaALphaALphaALphaALpha3f31feSSarC";
       "ProtoALphaALphaALphaALphaALphaALphaALphabe31ahnkxSC";
       "ProtoALphaALphaALphaALphaALphaALphaALphabab3bgRb7zQ";
       "ProtoALphaALphaALphaALphaALphaALphaALphaf8d39cctbpk";
       "ProtoALphaALphaALphaALphaALphaALphaALpha3b981byuYxD";
       "ProtoALphaALphaALphaALphaALphaALphaALphaa116bccYowi";
       "ProtoALphaALphaALphaALphaALphaALphaALphacce68eHqboj";
       "ProtoALphaALphaALphaALphaALphaALphaALpha225c7YrWwR7";
       "ProtoALphaALphaALphaALphaALphaALphaALpha58743cJL6FG";
       "ProtoALphaALphaALphaALphaALphaALphaALphac91bcdvmJFR";
       "ProtoALphaALphaALphaALphaALphaALphaALpha1faaadhV7oW";
       "ProtoALphaALphaALphaALphaALphaALphaALpha98232gD94QJ";
       "ProtoALphaALphaALphaALphaALphaALphaALpha9d1d8cijvAh";
       "ProtoALphaALphaALphaALphaALphaALphaALphaeec52dKF6Gx";
       "ProtoALphaALphaALphaALphaALphaALphaALpha841f2cQqajX" |]

(** helper functions *)
let mk_contracts_from_pkh pkh_list =
  List.map Alpha_context.Contract.implicit_contract pkh_list

(* get the list of delegates and the list of their rolls from listings *)
let get_delegates_and_rolls_from_listings b =
  Context.Vote.get_listings (B b)
  >>=? fun l -> return (mk_contracts_from_pkh (List.map fst l), List.map snd l)

(* compute the rolls of each delegate *)
let get_rolls b delegates loc =
  Context.Vote.get_listings (B b)
  >>=? fun l ->
  map_s
    (fun delegate ->
      Context.Contract.pkh delegate
      >>=? fun pkh ->
      match List.find_opt (fun (del, _) -> del = pkh) l with
      | None ->
          failwith "%s - Missing delegate" loc
      | Some (_, rolls) ->
          return rolls)
    delegates

let test_successful_vote num_delegates () =
  let min_proposal_quorum = Int32.(of_int @@ (100_00 / num_delegates)) in
  Context.init ~min_proposal_quorum num_delegates
  >>=? fun (b, _) ->
  Context.get_constants (B b)
  >>=? fun {parametric = {blocks_per_voting_period; _}; _} ->
  (* no ballots in proposal period *)
  Context.Vote.get_ballots (B b)
  >>=? fun v ->
  Assert.equal
    ~loc:__LOC__
    ballots_equal
    "Unexpected ballots"
    ballots_pp
    v
    ballots_zero
  >>=? fun () ->
  (* no ballots in proposal period *)
  Context.Vote.get_ballot_list (B b)
  >>=? (function
         | [] ->
             return_unit
         | _ ->
             failwith "%s - Unexpected ballot list" __LOC__)
  >>=? fun () ->
  (* period 0 *)
  Context.Vote.get_voting_period (B b)
  >>=? fun v ->
  let open Alpha_context in
  Assert.equal
    ~loc:__LOC__
    Voting_period.equal
    "Unexpected period"
    Voting_period.pp
    v
    Voting_period.(root)
  >>=? fun () ->
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Proposal ->
             return_unit
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () ->
  (* participation EMA starts at initial_participation *)
  Context.Vote.get_participation_ema b
  >>=? fun v ->
  Assert.equal_int ~loc:__LOC__ initial_participation (Int32.to_int v)
  >>=? fun () ->
  (* listings must be populated in proposal period *)
  Context.Vote.get_listings (B b)
  >>=? (function
         | [] ->
             failwith "%s - Unexpected empty listings" __LOC__
         | _ ->
             return_unit)
  >>=? fun () ->
  (* beginning of proposal, denoted by _p1;
     take a snapshot of the active delegates and their rolls from listings *)
  get_delegates_and_rolls_from_listings b
  >>=? fun (delegates_p1, rolls_p1) ->
  (* no proposals at the beginning of proposal period *)
  Context.Vote.get_proposals (B b)
  >>=? fun ps ->
  ( if Environment.Protocol_hash.Map.is_empty ps then return_unit
  else failwith "%s - Unexpected proposals" __LOC__ )
  >>=? fun () ->
  (* no current proposal during proposal period *)
  Context.Vote.get_current_proposal (B b)
  >>=? (function
         | None ->
             return_unit
         | Some _ ->
             failwith "%s - Unexpected proposal" __LOC__)
  >>=? fun () ->
  let del1 = List.nth delegates_p1 0 in
  let del2 = List.nth delegates_p1 1 in
  let props =
    List.map (fun i -> protos.(i)) (2 -- Constants.max_proposals_per_delegate)
  in
  Op.proposals (B b) del1 (Protocol_hash.zero :: props)
  >>=? fun ops1 ->
  Op.proposals (B b) del2 [Protocol_hash.zero]
  >>=? fun ops2 ->
  Block.bake ~operations:[ops1; ops2] b
  >>=? fun b ->
  (* proposals are now populated *)
  Context.Vote.get_proposals (B b)
  >>=? fun ps ->
  (* correctly count the double proposal for zero *)
  (let weight = Int32.add (List.nth rolls_p1 0) (List.nth rolls_p1 1) in
   match Environment.Protocol_hash.(Map.find_opt zero ps) with
   | Some v ->
       if v = weight then return_unit
       else failwith "%s - Wrong count %ld is not %ld" __LOC__ v weight
   | None ->
       failwith "%s - Missing proposal" __LOC__)
  >>=? fun () ->
  (* proposing more than maximum_proposals fails *)
  Op.proposals (B b) del1 (Protocol_hash.zero :: props)
  >>=? fun ops ->
  Block.bake ~operations:[ops] b
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Amendment.Too_many_proposals ->
          true
      | _ ->
          false)
  >>=? fun () ->
  (* proposing less than one proposal fails *)
  Op.proposals (B b) del1 []
  >>=? fun ops ->
  Block.bake ~operations:[ops] b
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Amendment.Empty_proposal ->
          true
      | _ ->
          false)
  >>=? fun () ->
  (* skip to testing_vote period
     -1 because we already baked one block with the proposal *)
  Block.bake_n (Int32.to_int blocks_per_voting_period - 2) b
  >>=? fun b ->
  (* we moved to a testing_vote period with one proposal *)
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Testing_vote ->
             return_unit
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () ->
  (* period 1 *)
  Context.Vote.get_voting_period (B b)
  >>=? fun v ->
  let open Alpha_context in
  Assert.equal
    ~loc:__LOC__
    Voting_period.equal
    "Unexpected period"
    Voting_period.pp
    v
    Voting_period.(succ root)
  >>=? fun () ->
  (* listings must be populated in testing_vote period *)
  Context.Vote.get_listings (B b)
  >>=? (function
         | [] ->
             failwith "%s - Unexpected empty listings" __LOC__
         | _ ->
             return_unit)
  >>=? fun () ->
  (* beginning of testing_vote period, denoted by _p2;
     take a snapshot of the active delegates and their rolls from listings *)
  get_delegates_and_rolls_from_listings b
  >>=? fun (delegates_p2, rolls_p2) ->
  (* no proposals during testing_vote period *)
  Context.Vote.get_proposals (B b)
  >>=? fun ps ->
  ( if Environment.Protocol_hash.Map.is_empty ps then return_unit
  else failwith "%s - Unexpected proposals" __LOC__ )
  >>=? fun () ->
  (* current proposal must be set during testing_vote period *)
  Context.Vote.get_current_proposal (B b)
  >>=? (function
         | Some v ->
             if Protocol_hash.(equal zero v) then return_unit
             else failwith "%s - Wrong proposal" __LOC__
         | None ->
             failwith "%s - Missing proposal" __LOC__)
  >>=? fun () ->
  (* unanimous vote: all delegates --active when p2 started-- vote *)
  map_s
    (fun del -> Op.ballot (B b) del Protocol_hash.zero Vote.Yay)
    delegates_p2
  >>=? fun operations ->
  Block.bake ~operations b
  >>=? fun b ->
  Op.ballot (B b) del1 Protocol_hash.zero Vote.Nay
  >>=? fun op ->
  Block.bake ~operations:[op] b
  >>= fun res ->
  Assert.proto_error ~loc:__LOC__ res (function
      | Amendment.Unauthorized_ballot ->
          true
      | _ ->
          false)
  >>=? fun () ->
  fold_left_s (fun v acc -> return Int32.(add v acc)) 0l rolls_p2
  >>=? fun rolls_sum ->
  (* # of Yays in ballots matches rolls of the delegate *)
  Context.Vote.get_ballots (B b)
  >>=? fun v ->
  Assert.equal
    ~loc:__LOC__
    ballots_equal
    "Unexpected ballots"
    ballots_pp
    v
    Vote.{yay = rolls_sum; nay = 0l; pass = 0l}
  >>=? fun () ->
  (* One Yay ballot per delegate *)
  Context.Vote.get_ballot_list (B b)
  >>=? (function
         | [] ->
             failwith "%s - Unexpected empty ballot list" __LOC__
         | l ->
             iter_s
               (fun delegate ->
                 Context.Contract.pkh delegate
                 >>=? fun pkh ->
                 match List.find_opt (fun (del, _) -> del = pkh) l with
                 | None ->
                     failwith "%s - Missing delegate" __LOC__
                 | Some (_, Vote.Yay) ->
                     return_unit
                 | Some _ ->
                     failwith "%s - Wrong ballot" __LOC__)
               delegates_p2)
  >>=? fun () ->
  (* skip to testing period
     -1 because we already baked one block with the ballot *)
  Block.bake_n (Int32.to_int blocks_per_voting_period - 1) b
  >>=? fun b ->
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Testing ->
             return_unit
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () ->
  (* period 2 *)
  Context.Vote.get_voting_period (B b)
  >>=? fun v ->
  let open Alpha_context in
  Assert.equal
    ~loc:__LOC__
    Voting_period.equal
    "Unexpected period"
    Voting_period.pp
    v
    Voting_period.(succ (succ root))
  >>=? fun () ->
  (* no ballots in testing period *)
  Context.Vote.get_ballots (B b)
  >>=? fun v ->
  Assert.equal
    ~loc:__LOC__
    ballots_equal
    "Unexpected ballots"
    ballots_pp
    v
    ballots_zero
  >>=? fun () ->
  (* listings must be empty in testing period *)
  Context.Vote.get_listings (B b)
  >>=? (function
         | [] -> return_unit | _ -> failwith "%s - Unexpected listings" __LOC__)
  >>=? fun () ->
  (* skip to promotion_vote period *)
  Block.bake_n (Int32.to_int blocks_per_voting_period) b
  >>=? fun b ->
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Promotion_vote ->
             return_unit
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () ->
  (* period 3 *)
  Context.Vote.get_voting_period (B b)
  >>=? fun v ->
  let open Alpha_context in
  Assert.equal
    ~loc:__LOC__
    Voting_period.equal
    "Unexpected period"
    Voting_period.pp
    v
    Voting_period.(succ (succ (succ root)))
  >>=? fun () ->
  (* listings must be populated in promotion_vote period *)
  Context.Vote.get_listings (B b)
  >>=? (function
         | [] ->
             failwith "%s - Unexpected empty listings" __LOC__
         | _ ->
             return_unit)
  >>=? fun () ->
  (* beginning of promotion_vote period, denoted by _p4;
     take a snapshot of the active delegates and their rolls from listings *)
  get_delegates_and_rolls_from_listings b
  >>=? fun (delegates_p4, rolls_p4) ->
  (* no proposals during promotion_vote period *)
  Context.Vote.get_proposals (B b)
  >>=? fun ps ->
  ( if Environment.Protocol_hash.Map.is_empty ps then return_unit
  else failwith "%s - Unexpected proposals" __LOC__ )
  >>=? fun () ->
  (* current proposal must be set during promotion_vote period *)
  Context.Vote.get_current_proposal (B b)
  >>=? (function
         | Some v ->
             if Protocol_hash.(equal zero v) then return_unit
             else failwith "%s - Wrong proposal" __LOC__
         | None ->
             failwith "%s - Missing proposal" __LOC__)
  >>=? fun () ->
  (* unanimous vote: all delegates --active when p4 started-- vote *)
  map_s
    (fun del -> Op.ballot (B b) del Protocol_hash.zero Vote.Yay)
    delegates_p4
  >>=? fun operations ->
  Block.bake ~operations b
  >>=? fun b ->
  fold_left_s (fun v acc -> return Int32.(add v acc)) 0l rolls_p4
  >>=? fun rolls_sum ->
  (* # of Yays in ballots matches rolls of the delegate *)
  Context.Vote.get_ballots (B b)
  >>=? fun v ->
  Assert.equal
    ~loc:__LOC__
    ballots_equal
    "Unexpected ballots"
    ballots_pp
    v
    Vote.{yay = rolls_sum; nay = 0l; pass = 0l}
  >>=? fun () ->
  (* One Yay ballot per delegate *)
  Context.Vote.get_ballot_list (B b)
  >>=? (function
         | [] ->
             failwith "%s - Unexpected empty ballot list" __LOC__
         | l ->
             iter_s
               (fun delegate ->
                 Context.Contract.pkh delegate
                 >>=? fun pkh ->
                 match List.find_opt (fun (del, _) -> del = pkh) l with
                 | None ->
                     failwith "%s - Missing delegate" __LOC__
                 | Some (_, Vote.Yay) ->
                     return_unit
                 | Some _ ->
                     failwith "%s - Wrong ballot" __LOC__)
               delegates_p4)
  >>=? fun () ->
  (* skip to end of promotion_vote period and activation*)
  Block.bake_n Int32.(to_int blocks_per_voting_period - 1) b
  >>=? fun b ->
  (* zero is the new protocol (before the vote this value is unset) *)
  Context.Vote.get_protocol b
  >>= fun p ->
  Assert.equal
    ~loc:__LOC__
    Protocol_hash.equal
    "Unexpected proposal"
    Protocol_hash.pp
    p
    Protocol_hash.zero
  >>=? fun () -> return_unit

(* given a list of active delegates,
   return the first k active delegates with which one can have quorum, that is:
   their roll sum divided by the total roll sum is bigger than pr_ema_weight/den *)
let get_smallest_prefix_voters_for_quorum active_delegates active_rolls =
  fold_left_s (fun v acc -> return Int32.(add v acc)) 0l active_rolls
  >>=? fun active_rolls_sum ->
  let rec loop delegates rolls sum selected =
    match (delegates, rolls) with
    | ([], []) ->
        selected
    | (del :: delegates, del_rolls :: rolls) ->
        if
          den * sum
          < Float.to_int (expected_qr_num *. Int32.to_float active_rolls_sum)
        then
          loop delegates rolls (sum + Int32.to_int del_rolls) (del :: selected)
        else selected
    | (_, _) ->
        []
  in
  return (loop active_delegates active_rolls 0 [])

let get_expected_participation_ema rolls voter_rolls old_participation_ema =
  (* formula to compute the updated participation_ema *)
  let get_updated_participation_ema old_participation_ema participation =
    ( (pr_ema_weight * Int32.to_int old_participation_ema)
    + (pr_num * participation) )
    / den
  in
  fold_left_s (fun v acc -> return Int32.(add v acc)) 0l rolls
  >>=? fun rolls_sum ->
  fold_left_s (fun v acc -> return Int32.(add v acc)) 0l voter_rolls
  >>=? fun voter_rolls_sum ->
  let participation =
    Int32.to_int voter_rolls_sum * percent_mul / Int32.to_int rolls_sum
  in
  return (get_updated_participation_ema old_participation_ema participation)

(* if not enough quorum -- get_updated_participation_ema < pr_ema_weight/den -- in testing vote,
   go back to proposal period *)
let test_not_enough_quorum_in_testing_vote num_delegates () =
  let min_proposal_quorum = Int32.(of_int @@ (100_00 / num_delegates)) in
  Context.init ~min_proposal_quorum num_delegates
  >>=? fun (b, delegates) ->
  Context.get_constants (B b)
  >>=? fun {parametric = {blocks_per_voting_period; _}; _} ->
  (* proposal period *)
  let open Alpha_context in
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Proposal ->
             return_unit
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () ->
  let proposer = List.nth delegates 0 in
  Op.proposals (B b) proposer [Protocol_hash.zero]
  >>=? fun ops ->
  Block.bake ~operations:[ops] b
  >>=? fun b ->
  (* skip to vote_testing period
     -1 because we already baked one block with the proposal *)
  Block.bake_n (Int32.to_int blocks_per_voting_period - 2) b
  >>=? fun b ->
  (* we moved to a testing_vote period with one proposal *)
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Testing_vote ->
             return_unit
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () ->
  Context.Vote.get_participation_ema b
  >>=? fun initial_participation_ema ->
  (* beginning of testing_vote period, denoted by _p2;
     take a snapshot of the active delegates and their rolls from listings *)
  get_delegates_and_rolls_from_listings b
  >>=? fun (delegates_p2, rolls_p2) ->
  get_smallest_prefix_voters_for_quorum delegates_p2 rolls_p2
  >>=? fun voters ->
  (* take the first two voters out so there cannot be quorum *)
  let voters_without_quorum = List.tl voters in
  get_rolls b voters_without_quorum __LOC__
  >>=? fun voters_rolls_in_testing_vote ->
  (* all voters_without_quorum vote, for yays;
     no nays, so supermajority is satisfied *)
  map_s
    (fun del -> Op.ballot (B b) del Protocol_hash.zero Vote.Yay)
    voters_without_quorum
  >>=? fun operations ->
  Block.bake ~operations b
  >>=? fun b ->
  (* skip to testing period *)
  Block.bake_n (Int32.to_int blocks_per_voting_period - 1) b
  >>=? fun b ->
  (* we move back to the proposal period because not enough quorum *)
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Proposal ->
             return_unit
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () ->
  (* check participation_ema update *)
  get_expected_participation_ema
    rolls_p2
    voters_rolls_in_testing_vote
    initial_participation_ema
  >>=? fun expected_participation_ema ->
  Context.Vote.get_participation_ema b
  >>=? fun new_participation_ema ->
  (* assert the formula to calculate participation_ema is correct *)
  Assert.equal_int
    ~loc:__LOC__
    expected_participation_ema
    (Int32.to_int new_participation_ema)
  >>=? fun () -> return_unit

(* if not enough quorum -- get_updated_participation_ema < pr_ema_weight/den -- in promotion vote,
   go back to proposal period *)
let test_not_enough_quorum_in_promotion_vote num_delegates () =
  let min_proposal_quorum = Int32.(of_int @@ (100_00 / num_delegates)) in
  Context.init ~min_proposal_quorum num_delegates
  >>=? fun (b, delegates) ->
  Context.get_constants (B b)
  >>=? fun {parametric = {blocks_per_voting_period; _}; _} ->
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Proposal ->
             return_unit
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () ->
  let proposer = List.nth delegates 0 in
  Op.proposals (B b) proposer [Protocol_hash.zero]
  >>=? fun ops ->
  Block.bake ~operations:[ops] b
  >>=? fun b ->
  (* skip to vote_testing period
     -1 because we already baked one block with the proposal *)
  Block.bake_n (Int32.to_int blocks_per_voting_period - 2) b
  >>=? fun b ->
  (* we moved to a testing_vote period with one proposal *)
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Testing_vote ->
             return_unit
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () ->
  (* beginning of testing_vote period, denoted by _p2;
     take a snapshot of the active delegates and their rolls from listings *)
  get_delegates_and_rolls_from_listings b
  >>=? fun (delegates_p2, rolls_p2) ->
  get_smallest_prefix_voters_for_quorum delegates_p2 rolls_p2
  >>=? fun voters ->
  let open Alpha_context in
  (* all voters vote, for yays;
       no nays, so supermajority is satisfied *)
  map_s (fun del -> Op.ballot (B b) del Protocol_hash.zero Vote.Yay) voters
  >>=? fun operations ->
  Block.bake ~operations b
  >>=? fun b ->
  (* skip to testing period *)
  Block.bake_n (Int32.to_int blocks_per_voting_period - 1) b
  >>=? fun b ->
  (* we move to testing because we have supermajority and enough quorum *)
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Testing ->
             return_unit
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () ->
  (* skip to promotion_vote period *)
  Block.bake_n (Int32.to_int blocks_per_voting_period) b
  >>=? fun b ->
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Promotion_vote ->
             return_unit
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () ->
  Context.Vote.get_participation_ema b
  >>=? fun initial_participation_ema ->
  (* beginning of promotion period, denoted by _p4;
     take a snapshot of the active delegates and their rolls from listings *)
  get_delegates_and_rolls_from_listings b
  >>=? fun (delegates_p4, rolls_p4) ->
  get_smallest_prefix_voters_for_quorum delegates_p4 rolls_p4
  >>=? fun voters ->
  (* take the first voter out so there cannot be quorum *)
  let voters_without_quorum = List.tl voters in
  get_rolls b voters_without_quorum __LOC__
  >>=? fun voter_rolls ->
  (* all voters_without_quorum vote, for yays;
     no nays, so supermajority is satisfied *)
  map_s
    (fun del -> Op.ballot (B b) del Protocol_hash.zero Vote.Yay)
    voters_without_quorum
  >>=? fun operations ->
  Block.bake ~operations b
  >>=? fun b ->
  (* skip to end of promotion_vote period *)
  Block.bake_n (Int32.to_int blocks_per_voting_period - 1) b
  >>=? fun b ->
  get_expected_participation_ema rolls_p4 voter_rolls initial_participation_ema
  >>=? fun expected_participation_ema ->
  Context.Vote.get_participation_ema b
  >>=? fun new_participation_ema ->
  (* assert the formula to calculate participation_ema is correct *)
  Assert.equal_int
    ~loc:__LOC__
    expected_participation_ema
    (Int32.to_int new_participation_ema)
  >>=? fun () ->
  (* we move back to the proposal period because not enough quorum *)
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Proposal ->
             return_unit
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () -> return_unit

let test_multiple_identical_proposals_count_as_one () =
  Context.init 1
  >>=? fun (b, delegates) ->
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Proposal ->
             return_unit
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () ->
  let proposer = List.hd delegates in
  Op.proposals (B b) proposer [Protocol_hash.zero; Protocol_hash.zero]
  >>=? fun ops ->
  Block.bake ~operations:[ops] b
  >>=? fun b ->
  (* compute the weight of proposals *)
  Context.Vote.get_proposals (B b)
  >>=? fun ps ->
  (* compute the rolls of proposer *)
  Context.Contract.pkh proposer
  >>=? fun pkh ->
  Context.Vote.get_listings (B b)
  >>=? fun l ->
  ( match List.find_opt (fun (del, _) -> del = pkh) l with
  | None ->
      failwith "%s - Missing delegate" __LOC__
  | Some (_, proposer_rolls) ->
      return proposer_rolls )
  >>=? fun proposer_rolls ->
  (* correctly count the double proposal for zero as one proposal *)
  let expected_weight_proposer = proposer_rolls in
  match Environment.Protocol_hash.(Map.find_opt zero ps) with
  | Some v ->
      if v = expected_weight_proposer then return_unit
      else
        failwith
          "%s - Wrong count %ld is not %ld; identical proposals count as one"
          __LOC__
          v
          expected_weight_proposer
  | None ->
      failwith "%s - Missing proposal" __LOC__

(* assumes the initial balance of allocated by Context.init is at
   least 4 time the value of the tokens_per_roll constant *)
let test_supermajority_in_proposal there_is_a_winner () =
  let min_proposal_quorum = 0l in
  Context.init ~min_proposal_quorum ~initial_balances:[1L; 1L; 1L] 10
  >>=? fun (b, delegates) ->
  Context.get_constants (B b)
  >>=? fun { parametric =
               {blocks_per_cycle; blocks_per_voting_period; tokens_per_roll; _};
             _ } ->
  let del1 = List.nth delegates 0 in
  let del2 = List.nth delegates 1 in
  let del3 = List.nth delegates 2 in
  map_s (fun del -> Context.Contract.pkh del) [del1; del2; del3]
  >>=? fun pkhs ->
  let policy = Block.Excluding pkhs in
  Op.transaction (B b) (List.nth delegates 3) del1 tokens_per_roll
  >>=? fun op1 ->
  Op.transaction (B b) (List.nth delegates 4) del2 tokens_per_roll
  >>=? fun op2 ->
  ( if there_is_a_winner then Test_tez.Tez.( *? ) tokens_per_roll 3L
  else Test_tez.Tez.( *? ) tokens_per_roll 2L )
  >>?= fun bal3 ->
  Op.transaction (B b) (List.nth delegates 5) del3 bal3
  >>=? fun op3 ->
  Block.bake ~policy ~operations:[op1; op2; op3] b
  >>=? fun b ->
  (* we let one voting period pass; we make sure that:
     - the three selected delegates remain active by re-registering as delegates
     - their number of rolls do not change *)
  fold_left_s
    (fun b _ ->
      Error_monad.map_s
        (fun del ->
          Context.Contract.pkh del
          >>=? fun pkh -> Op.delegation (B b) del (Some pkh))
        delegates
      >>=? fun ops ->
      Block.bake ~policy ~operations:ops b
      >>=? fun b -> Block.bake_until_cycle_end ~policy b)
    b
    (1 -- Int32.to_int (Int32.div blocks_per_voting_period blocks_per_cycle))
  >>=? fun b ->
  (* make the proposals *)
  Op.proposals (B b) del1 [protos.(0)]
  >>=? fun ops1 ->
  Op.proposals (B b) del2 [protos.(0)]
  >>=? fun ops2 ->
  Op.proposals (B b) del3 [protos.(1)]
  >>=? fun ops3 ->
  Block.bake ~policy ~operations:[ops1; ops2; ops3] b
  >>=? fun b ->
  Block.bake_n ~policy (Int32.to_int blocks_per_voting_period - 1) b
  >>=? fun b ->
  (* we remain in the proposal period when there is no winner,
     otherwise we move to the testing vote period *)
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Testing_vote ->
             if there_is_a_winner then return_unit
             else
               failwith
                 "%s - Expected period kind Proposal, obtained Testing_vote"
                 __LOC__
         | Proposal ->
             if not there_is_a_winner then return_unit
             else
               failwith
                 "%s - Expected period kind Testing_vote, obtained Proposal"
                 __LOC__
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () -> return_unit

let test_quorum_in_proposal has_quorum () =
  let total_tokens = 32_000_000_000_000L in
  let half_tokens = Int64.div total_tokens 2L in
  Context.init ~initial_balances:[1L; half_tokens; half_tokens] 3
  >>=? fun (b, delegates) ->
  Context.get_constants (B b)
  >>=? fun { parametric =
               { blocks_per_cycle;
                 blocks_per_voting_period;
                 min_proposal_quorum;
                 _ };
             _ } ->
  let del1 = List.nth delegates 0 in
  let del2 = List.nth delegates 1 in
  map_s (fun del -> Context.Contract.pkh del) [del1; del2]
  >>=? fun pkhs ->
  let policy = Block.Excluding pkhs in
  let quorum =
    if has_quorum then Int64.of_int32 min_proposal_quorum
    else Int64.(sub (of_int32 min_proposal_quorum) 10L)
  in
  let bal =
    Int64.(div (mul total_tokens quorum) 100_00L) |> Test_tez.Tez.of_mutez_exn
  in
  Op.transaction (B b) del2 del1 bal
  >>=? fun op2 ->
  Block.bake ~policy ~operations:[op2] b
  >>=? fun b ->
  (* we let one voting period pass; we make sure that:
     - the two selected delegates remain active by re-registering as delegates
     - their number of rolls do not change *)
  fold_left_s
    (fun b _ ->
      Error_monad.map_s
        (fun del ->
          Context.Contract.pkh del
          >>=? fun pkh -> Op.delegation (B b) del (Some pkh))
        [del1; del2]
      >>=? fun ops ->
      Block.bake ~policy ~operations:ops b
      >>=? fun b -> Block.bake_until_cycle_end ~policy b)
    b
    (1 -- Int32.to_int (Int32.div blocks_per_voting_period blocks_per_cycle))
  >>=? fun b ->
  (* make the proposal *)
  Op.proposals (B b) del1 [protos.(0)]
  >>=? fun ops ->
  Block.bake ~policy ~operations:[ops] b
  >>=? fun b ->
  Block.bake_n ~policy (Int32.to_int blocks_per_voting_period - 1) b
  >>=? fun b ->
  (* we remain in the proposal period when there is no quorum,
     otherwise we move to the testing vote period *)
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Testing_vote ->
             if has_quorum then return_unit
             else
               failwith
                 "%s - Expected period kind Proposal, obtained Testing_vote"
                 __LOC__
         | Proposal ->
             if not has_quorum then return_unit
             else
               failwith
                 "%s - Expected period kind Testing_vote, obtained Proposal"
                 __LOC__
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () -> return_unit

let test_supermajority_in_testing_vote supermajority () =
  let min_proposal_quorum = Int32.(of_int @@ (100_00 / 100)) in
  Context.init ~min_proposal_quorum 100
  >>=? fun (b, delegates) ->
  Context.get_constants (B b)
  >>=? fun {parametric = {blocks_per_voting_period; _}; _} ->
  let del1 = List.nth delegates 0 in
  let proposal = protos.(0) in
  Op.proposals (B b) del1 [proposal]
  >>=? fun ops1 ->
  Block.bake ~operations:[ops1] b
  >>=? fun b ->
  Block.bake_n (Int32.to_int blocks_per_voting_period - 1) b
  >>=? fun b ->
  (* move to testing_vote *)
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Testing_vote ->
             return_unit
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () ->
  (* assert our proposal won *)
  Context.Vote.get_current_proposal (B b)
  >>=? (function
         | Some v ->
             if Protocol_hash.(equal proposal v) then return_unit
             else failwith "%s - Wrong proposal" __LOC__
         | None ->
             failwith "%s - Missing proposal" __LOC__)
  >>=? fun () ->
  (* beginning of testing_vote period, denoted by _p2;
     take a snapshot of the active delegates and their rolls from listings *)
  get_delegates_and_rolls_from_listings b
  >>=? fun (delegates_p2, _olls_p2) ->
  (* supermajority means [num_yays / (num_yays + num_nays) >= s_num / s_den],
     which is equivalent with [num_yays >= num_nays * s_num / (s_den - s_num)] *)
  let num_delegates = List.length delegates_p2 in
  let num_nays = num_delegates / 5 in
  (* any smaller number will do as well *)
  let num_yays = num_nays * s_num / (s_den - s_num) in
  (* majority/minority vote depending on the [supermajority] parameter *)
  let num_yays = if supermajority then num_yays else num_yays - 1 in
  let open Alpha_context in
  let (nays_delegates, rest) = List.split_n num_nays delegates_p2 in
  let (yays_delegates, _) = List.split_n num_yays rest in
  map_s (fun del -> Op.ballot (B b) del proposal Vote.Yay) yays_delegates
  >>=? fun operations_yays ->
  map_s (fun del -> Op.ballot (B b) del proposal Vote.Nay) nays_delegates
  >>=? fun operations_nays ->
  let operations = operations_yays @ operations_nays in
  Block.bake ~operations b
  >>=? fun b ->
  Block.bake_n (Int32.to_int blocks_per_voting_period - 1) b
  >>=? fun b ->
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Testing ->
             if supermajority then return_unit
             else
               failwith
                 "%s - Expected period kind Proposal, obtained Testing"
                 __LOC__
         | Proposal ->
             if not supermajority then return_unit
             else
               failwith
                 "%s - Expected period kind Testing_vote, obtained Proposal"
                 __LOC__
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () -> return_unit

(* test also how the selection scales: all delegates propose max proposals *)
let test_no_winning_proposal num_delegates () =
  let min_proposal_quorum = Int32.(of_int @@ (100_00 / num_delegates)) in
  Context.init ~min_proposal_quorum num_delegates
  >>=? fun (b, _) ->
  Context.get_constants (B b)
  >>=? fun {parametric = {blocks_per_voting_period; _}; _} ->
  (* beginning of proposal, denoted by _p1;
     take a snapshot of the active delegates and their rolls from listings *)
  get_delegates_and_rolls_from_listings b
  >>=? fun (delegates_p1, _rolls_p1) ->
  let open Alpha_context in
  let props =
    List.map (fun i -> protos.(i)) (1 -- Constants.max_proposals_per_delegate)
  in
  (* all delegates active in p1 propose the same proposals *)
  map_s (fun del -> Op.proposals (B b) del props) delegates_p1
  >>=? fun ops_list ->
  Block.bake ~operations:ops_list b
  >>=? fun b ->
  (* skip to testing_vote period
     -1 because we already baked one block with the proposal *)
  Block.bake_n (Int32.to_int blocks_per_voting_period - 2) b
  >>=? fun b ->
  (* we stay in the same proposal period because no winning proposal *)
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Proposal ->
             return_unit
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () -> return_unit

(** Test that for the vote to pass with maximum possible participation_ema
    (100%), it is sufficient for the vote quorum to be equal or greater than
    the maximum quorum cap. *)
let test_quorum_capped_maximum num_delegates () =
  let min_proposal_quorum = Int32.(of_int @@ (100_00 / num_delegates)) in
  Context.init ~min_proposal_quorum num_delegates
  >>=? fun (b, delegates) ->
  (* set the participation EMA to 100% *)
  Context.Vote.set_participation_ema b 100_00l
  >>= fun b ->
  Context.get_constants (B b)
  >>=? fun {parametric = {blocks_per_voting_period; quorum_max; _}; _} ->
  (* proposal period *)
  let open Alpha_context in
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Proposal ->
             return_unit
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () ->
  (* propose a new protocol *)
  let protocol = Protocol_hash.zero in
  let proposer = List.nth delegates 0 in
  Op.proposals (B b) proposer [protocol]
  >>=? fun ops ->
  Block.bake ~operations:[ops] b
  >>=? fun b ->
  (* skip to vote_testing period
     -1 because we already baked one block with the proposal *)
  Block.bake_n (Int32.to_int blocks_per_voting_period - 1) b
  >>=? fun b ->
  (* we moved to a testing_vote period with one proposal *)
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Testing_vote ->
             return_unit
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () ->
  (* take percentage of the delegates equal or greater than quorum_max *)
  let minimum_to_pass =
    Float.of_int (List.length delegates)
    *. Int32.(to_float quorum_max)
    /. 100_00.
    |> Float.ceil |> Float.to_int
  in
  let voters = List.take_n minimum_to_pass delegates in
  (* all voters vote for yays; no nays, so supermajority is satisfied *)
  map_s (fun del -> Op.ballot (B b) del protocol Vote.Yay) voters
  >>=? fun operations ->
  Block.bake ~operations b
  >>=? fun b ->
  (* skip to next period *)
  Block.bake_n (Int32.to_int blocks_per_voting_period - 1) b
  >>=? fun b ->
  (* expect to move to testing because we have supermajority and enough quorum *)
  Context.Vote.get_current_period_kind (B b)
  >>=? function
  | Testing ->
      return_unit
  | _ ->
      failwith "%s - Unexpected period kind" __LOC__

(** Test that for the vote to pass with minimum possible participation_ema
    (0%), it is sufficient for the vote quorum to be equal or greater than
    the minimum quorum cap. *)
let test_quorum_capped_minimum num_delegates () =
  let min_proposal_quorum = Int32.(of_int @@ (100_00 / num_delegates)) in
  Context.init ~min_proposal_quorum num_delegates
  >>=? fun (b, delegates) ->
  (* set the participation EMA to 0% *)
  Context.Vote.set_participation_ema b 0l
  >>= fun b ->
  Context.get_constants (B b)
  >>=? fun {parametric = {blocks_per_voting_period; quorum_min; _}; _} ->
  (* proposal period *)
  let open Alpha_context in
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Proposal ->
             return_unit
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () ->
  (* propose a new protocol *)
  let protocol = Protocol_hash.zero in
  let proposer = List.nth delegates 0 in
  Op.proposals (B b) proposer [protocol]
  >>=? fun ops ->
  Block.bake ~operations:[ops] b
  >>=? fun b ->
  (* skip to vote_testing period
     -1 because we already baked one block with the proposal *)
  Block.bake_n (Int32.to_int blocks_per_voting_period - 1) b
  >>=? fun b ->
  (* we moved to a testing_vote period with one proposal *)
  Context.Vote.get_current_period_kind (B b)
  >>=? (function
         | Testing_vote ->
             return_unit
         | _ ->
             failwith "%s - Unexpected period kind" __LOC__)
  >>=? fun () ->
  (* take percentage of the delegates equal or greater than quorum_min *)
  let minimum_to_pass =
    Float.of_int (List.length delegates)
    *. Int32.(to_float quorum_min)
    /. 100_00.
    |> Float.ceil |> Float.to_int
  in
  let voters = List.take_n minimum_to_pass delegates in
  (* all voters vote for yays; no nays, so supermajority is satisfied *)
  map_s (fun del -> Op.ballot (B b) del protocol Vote.Yay) voters
  >>=? fun operations ->
  Block.bake ~operations b
  >>=? fun b ->
  (* skip to next period *)
  Block.bake_n (Int32.to_int blocks_per_voting_period - 1) b
  >>=? fun b ->
  (* expect to move to testing because we have supermajority and enough quorum *)
  Context.Vote.get_current_period_kind (B b)
  >>=? function
  | Testing ->
      return_unit
  | _ ->
      failwith "%s - Unexpected period kind" __LOC__

let tests =
  [ Test.tztest "voting successful_vote" `Quick (test_successful_vote 137);
    Test.tztest
      "voting testing vote, not enough quorum"
      `Quick
      (test_not_enough_quorum_in_testing_vote 245);
    Test.tztest
      "voting promotion vote, not enough quorum"
      `Quick
      (test_not_enough_quorum_in_promotion_vote 432);
    Test.tztest
      "voting counting double proposal"
      `Quick
      test_multiple_identical_proposals_count_as_one;
    Test.tztest
      "voting proposal, with supermajority"
      `Quick
      (test_supermajority_in_proposal true);
    Test.tztest
      "voting proposal, without supermajority"
      `Quick
      (test_supermajority_in_proposal false);
    Test.tztest
      "voting proposal, with quorum"
      `Quick
      (test_quorum_in_proposal true);
    Test.tztest
      "voting proposal, without quorum"
      `Quick
      (test_quorum_in_proposal false);
    Test.tztest
      "voting testing vote, with supermajority"
      `Quick
      (test_supermajority_in_testing_vote true);
    Test.tztest
      "voting testing vote, without supermajority"
      `Quick
      (test_supermajority_in_testing_vote false);
    Test.tztest
      "voting proposal, no winning proposal"
      `Quick
      (test_no_winning_proposal 400);
    Test.tztest
      "voting quorum, quorum capped maximum"
      `Quick
      (test_quorum_capped_maximum 400);
    Test.tztest
      "voting quorum, quorum capped minimum"
      `Quick
      (test_quorum_capped_minimum 401) ]
voting_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Protocol.

Definition ballots_zero
  : Tezos_protocol_alpha.Protocol.Alpha_context.Vote.ballots :=
  {|
    yay :=
      (* ❌ Constant of type int32 is converted to int *)
      0;
    nay :=
      (* ❌ Constant of type int32 is converted to int *)
      0;
    pass :=
      (* ❌ Constant of type int32 is converted to int *)
      0 |}.

Definition ballots_equal
  (b1 : Tezos_protocol_alpha.Protocol.Alpha_context.Vote.ballots)
  (b2 : Tezos_protocol_alpha.Protocol.Alpha_context.Vote.ballots) : bool :=
  op_andand (op_startypeminuserrorstar (yay b1) (yay b2))
    (op_andand (op_startypeminuserrorstar (nay b1) (nay b2))
      (op_startypeminuserrorstar (pass b1) (pass b2))).

Definition ballots_pp
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (v : Tezos_protocol_alpha.Protocol.Alpha_context.Vote.ballots) : unit :=
  Format.fprintf ppf
    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
        "{ yay = " % string
        (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
          Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
          (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
            " ; nay = " % string
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
              Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                " ; pass = " % string
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format))))))
      "{ yay = %ld ; nay = %ld ; pass = %ld" % string) (yay v) (nay v) (pass v).

Definition percent_mul : Z := 10000.

Definition initial_participation_num : Z := 7.

Definition initial_participation : Z :=
  op_div (op_star initial_participation_num percent_mul) 10.

Definition pr_ema_weight : Z := 8.

Definition den : Z := 10.

Definition pr_num : Z := op_minus den pr_ema_weight.

Definition s_num : Z := 8.

Definition s_den : Z := 10.

Definition qr_min_num : Z := 2.

Definition qr_max_num : Z := 7.

Definition expected_qr_num {A : Type} : A := op_startypeminuserrorstar.

Definition protos {A : Type} : A :=
  op_startypeminuserrorstar
    (fun s =>
      Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.of_b58check_exn)
        s)
    (* ❌ Arrays not handled. *)
    [
      "ProtoALphaALphaALphaALphaALphaALphaALpha61322gcLUGH" % string;
      "ProtoALphaALphaALphaALphaALphaALphaALphabc2a7ebx6WB" % string;
      "ProtoALphaALphaALphaALphaALphaALphaALpha84efbeiF6cm" % string;
      "ProtoALphaALphaALphaALphaALphaALphaALpha91249Z65tWS" % string;
      "ProtoALphaALphaALphaALphaALphaALphaALpha537f5h25LnN" % string;
      "ProtoALphaALphaALphaALphaALphaALphaALpha5c8fefgDYkr" % string;
      "ProtoALphaALphaALphaALphaALphaALphaALpha3f31feSSarC" % string;
      "ProtoALphaALphaALphaALphaALphaALphaALphabe31ahnkxSC" % string;
      "ProtoALphaALphaALphaALphaALphaALphaALphabab3bgRb7zQ" % string;
      "ProtoALphaALphaALphaALphaALphaALphaALphaf8d39cctbpk" % string;
      "ProtoALphaALphaALphaALphaALphaALphaALpha3b981byuYxD" % string;
      "ProtoALphaALphaALphaALphaALphaALphaALphaa116bccYowi" % string;
      "ProtoALphaALphaALphaALphaALphaALphaALphacce68eHqboj" % string;
      "ProtoALphaALphaALphaALphaALphaALphaALpha225c7YrWwR7" % string;
      "ProtoALphaALphaALphaALphaALphaALphaALpha58743cJL6FG" % string;
      "ProtoALphaALphaALphaALphaALphaALphaALphac91bcdvmJFR" % string;
      "ProtoALphaALphaALphaALphaALphaALphaALpha1faaadhV7oW" % string;
      "ProtoALphaALphaALphaALphaALphaALphaALpha98232gD94QJ" % string;
      "ProtoALphaALphaALphaALphaALphaALphaALpha9d1d8cijvAh" % string;
      "ProtoALphaALphaALphaALphaALphaALphaALphaeec52dKF6Gx" % string;
      "ProtoALphaALphaALphaALphaALphaALphaALpha841f2cQqajX" % string
    ].

Definition mk_contracts_from_pkh
  (pkh_list : list Tezos_raw_protocol_alpha__Alpha_context.public_key_hash)
  : list Tezos_protocol_alpha.Protocol.Alpha_context.Contract.contract :=
  List.map Alpha_context.Contract.implicit_contract pkh_list.

Definition get_delegates_and_rolls_from_listings {A B : Type} (b : A)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (list Tezos_protocol_alpha.Protocol.Alpha_context.Contract.contract *
        list B)) :=
  op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
    (fun l =>
      __return ((mk_contracts_from_pkh (List.map fst l)), (List.map snd l))).

Definition get_rolls {A B C D : Type} (b : A) (delegates : list B) (loc : C)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult (list D)) :=
  op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
    (fun l =>
      map_s
        (fun delegate =>
          op_gtgteqquestion (op_startypeminuserrorstar delegate)
            (fun pkh =>
              match
                List.find_opt
                  (fun function_parameter =>
                    let '(del, _) := function_parameter in
                    op_startypeminuserrorstar del pkh) l with
              | None => failwith "%s - Missing delegate" % string loc
              | Some (_, rolls) => __return rolls
              end)) delegates).

Definition test_successful_vote (num_delegates : Z) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  let min_proposal_quorum := op_atat of_int (op_div 10000 num_delegates) in
  op_gtgteqquestion
    (op_startypeminuserrorstar min_proposal_quorum num_delegates)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
        (fun function_parameter =>
          let '_ := function_parameter in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar)
            (fun v =>
              op_gtgteqquestion
                (op_startypeminuserrorstar __LOC__ ballots_equal
                  "Unexpected ballots" % string ballots_pp v ballots_zero)
                (fun function_parameter =>
                  let 'tt := function_parameter in
                  op_gtgteqquestion
                    (op_gtgteqquestion
                      (op_startypeminuserrorstar op_startypeminuserrorstar)
                      (fun function_parameter =>
                        match function_parameter with
                        | [] => return_unit
                        | _ =>
                          failwith "%s - Unexpected ballot list" % string
                            __LOC__
                        end))
                    (fun function_parameter =>
                      let 'tt := function_parameter in
                      op_gtgteqquestion
                        (op_startypeminuserrorstar op_startypeminuserrorstar)
                        (fun v =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar __LOC__
                              Voting_period.equal "Unexpected period" % string
                              Voting_period.pp v root)
                            (fun function_parameter =>
                              let 'tt := function_parameter in
                              op_gtgteqquestion
                                (op_gtgteqquestion
                                  (op_startypeminuserrorstar
                                    op_startypeminuserrorstar)
                                  (fun function_parameter =>
                                    match function_parameter with
                                    | _ => return_unit
                                    | _ =>
                                      failwith
                                        "%s - Unexpected period kind" % string
                                        __LOC__
                                    end))
                                (fun function_parameter =>
                                  let 'tt := function_parameter in
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar b)
                                    (fun v =>
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar __LOC__
                                          initial_participation (Int32.to_int v))
                                        (fun function_parameter =>
                                          let 'tt := function_parameter in
                                          op_gtgteqquestion
                                            (op_gtgteqquestion
                                              (op_startypeminuserrorstar
                                                op_startypeminuserrorstar)
                                              (fun function_parameter =>
                                                match function_parameter with
                                                | [] =>
                                                  failwith
                                                    "%s - Unexpected empty listings"
                                                      % string __LOC__
                                                | _ => return_unit
                                                end))
                                            (fun function_parameter =>
                                              let 'tt := function_parameter in
                                              op_gtgteqquestion
                                                (get_delegates_and_rolls_from_listings
                                                  b)
                                                (fun function_parameter =>
                                                  let
                                                    '(delegates_p1, rolls_p1) :=
                                                    function_parameter in
                                                  op_gtgteqquestion
                                                    (op_startypeminuserrorstar
                                                      op_startypeminuserrorstar)
                                                    (fun ps =>
                                                      op_gtgteqquestion
                                                        (if
                                                          Environment.Protocol_hash.Map.is_empty
                                                            ps then
                                                          return_unit
                                                        else
                                                          failwith
                                                            "%s - Unexpected proposals"
                                                              % string __LOC__)
                                                        (fun function_parameter
                                                          =>
                                                          let 'tt :=
                                                            function_parameter
                                                            in
                                                          op_gtgteqquestion
                                                            (op_gtgteqquestion
                                                              (op_startypeminuserrorstar
                                                                op_startypeminuserrorstar)
                                                              (fun
                                                                function_parameter
                                                                =>
                                                                match
                                                                  function_parameter
                                                                  with
                                                                | None =>
                                                                  return_unit
                                                                | Some _ =>
                                                                  failwith
                                                                    "%s - Unexpected proposal"
                                                                      % string
                                                                    __LOC__
                                                                end))
                                                            (fun
                                                              function_parameter
                                                              =>
                                                              let 'tt :=
                                                                function_parameter
                                                                in
                                                              let del1 :=
                                                                op_startypeminuserrorstar
                                                                  delegates_p1 0
                                                                in
                                                              let del2 :=
                                                                op_startypeminuserrorstar
                                                                  delegates_p1 1
                                                                in
                                                              let props :=
                                                                List.map
                                                                  (fun i =>
                                                                    op_startypeminuserrorstar
                                                                      protos i)
                                                                  (op_startypeminuserrorstar
                                                                    2
                                                                    Constants.max_proposals_per_delegate)
                                                                in
                                                              op_gtgteqquestion
                                                                (op_startypeminuserrorstar
                                                                  op_startypeminuserrorstar
                                                                  del1
                                                                  (cons
                                                                    Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.zero)
                                                                    props))
                                                                (fun ops1 =>
                                                                  op_gtgteqquestion
                                                                    (op_startypeminuserrorstar
                                                                      op_startypeminuserrorstar
                                                                      del2
                                                                      (cons
                                                                        Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.zero)
                                                                        []))
                                                                    (fun ops2 =>
                                                                      op_gtgteqquestion
                                                                        (op_startypeminuserrorstar
                                                                          (cons
                                                                            ops1
                                                                            (cons
                                                                              ops2
                                                                              []))
                                                                          b)
                                                                        (fun b
                                                                          =>
                                                                          op_gtgteqquestion
                                                                            (op_startypeminuserrorstar
                                                                              op_startypeminuserrorstar)
                                                                            (fun
                                                                              ps
                                                                              =>
                                                                              op_gtgteqquestion
                                                                                (let
                                                                                  weight :=
                                                                                  Int32.add
                                                                                    (op_startypeminuserrorstar
                                                                                      rolls_p1
                                                                                      0)
                                                                                    (op_startypeminuserrorstar
                                                                                      rolls_p1
                                                                                      1)
                                                                                  in
                                                                                match
                                                                                  Map.find_opt
                                                                                    zero
                                                                                    ps
                                                                                  with
                                                                                |
                                                                                  Some
                                                                                    v
                                                                                  =>
                                                                                  if
                                                                                    op_startypeminuserrorstar
                                                                                      v
                                                                                      weight
                                                                                    then
                                                                                    return_unit
                                                                                  else
                                                                                    failwith
                                                                                      "%s - Wrong count %ld is not %ld"
                                                                                        %
                                                                                        string
                                                                                      __LOC__
                                                                                      v
                                                                                      weight
                                                                                |
                                                                                  None
                                                                                  =>
                                                                                  failwith
                                                                                    "%s - Missing proposal"
                                                                                      %
                                                                                      string
                                                                                    __LOC__
                                                                                end)
                                                                                (fun
                                                                                  function_parameter
                                                                                  =>
                                                                                  let
                                                                                    'tt :=
                                                                                    function_parameter
                                                                                    in
                                                                                  op_gtgteqquestion
                                                                                    (op_startypeminuserrorstar
                                                                                      op_startypeminuserrorstar
                                                                                      del1
                                                                                      (cons
                                                                                        Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.zero)
                                                                                        props))
                                                                                    (fun
                                                                                      ops
                                                                                      =>
                                                                                      op_gtgteq
                                                                                        (op_startypeminuserrorstar
                                                                                          (cons
                                                                                            ops
                                                                                            [])
                                                                                          b)
                                                                                        (fun
                                                                                          res
                                                                                          =>
                                                                                          op_gtgteqquestion
                                                                                            (op_startypeminuserrorstar
                                                                                              __LOC__
                                                                                              res
                                                                                              (fun
                                                                                                function_parameter
                                                                                                =>
                                                                                                match
                                                                                                  function_parameter
                                                                                                  with
                                                                                                |
                                                                                                  Tezos_protocol_environment_alpha__Environment.Error_monad.Too_many_proposals
                                                                                                  =>
                                                                                                  true
                                                                                                |
                                                                                                  _
                                                                                                  =>
                                                                                                  false
                                                                                                end))
                                                                                            (fun
                                                                                              function_parameter
                                                                                              =>
                                                                                              let
                                                                                                'tt :=
                                                                                                function_parameter
                                                                                                in
                                                                                              op_gtgteqquestion
                                                                                                (op_startypeminuserrorstar
                                                                                                  op_startypeminuserrorstar
                                                                                                  del1
                                                                                                  [])
                                                                                                (fun
                                                                                                  ops
                                                                                                  =>
                                                                                                  op_gtgteq
                                                                                                    (op_startypeminuserrorstar
                                                                                                      (cons
                                                                                                        ops
                                                                                                        [])
                                                                                                      b)
                                                                                                    (fun
                                                                                                      res
                                                                                                      =>
                                                                                                      op_gtgteqquestion
                                                                                                        (op_startypeminuserrorstar
                                                                                                          __LOC__
                                                                                                          res
                                                                                                          (fun
                                                                                                            function_parameter
                                                                                                            =>
                                                                                                            match
                                                                                                              function_parameter
                                                                                                              with
                                                                                                            |
                                                                                                              Tezos_protocol_environment_alpha__Environment.Error_monad.Empty_proposal
                                                                                                              =>
                                                                                                              true
                                                                                                            |
                                                                                                              _
                                                                                                              =>
                                                                                                              false
                                                                                                            end))
                                                                                                        (fun
                                                                                                          function_parameter
                                                                                                          =>
                                                                                                          let
                                                                                                            'tt :=
                                                                                                            function_parameter
                                                                                                            in
                                                                                                          op_gtgteqquestion
                                                                                                            (op_startypeminuserrorstar
                                                                                                              (op_minus
                                                                                                                (Int32.to_int
                                                                                                                  op_startypeminuserrorstar)
                                                                                                                2)
                                                                                                              b)
                                                                                                            (fun
                                                                                                              b
                                                                                                              =>
                                                                                                              op_gtgteqquestion
                                                                                                                (op_gtgteqquestion
                                                                                                                  (op_startypeminuserrorstar
                                                                                                                    op_startypeminuserrorstar)
                                                                                                                  (fun
                                                                                                                    function_parameter
                                                                                                                    =>
                                                                                                                    match
                                                                                                                      function_parameter
                                                                                                                      with
                                                                                                                    |
                                                                                                                      _
                                                                                                                      =>
                                                                                                                      return_unit
                                                                                                                    |
                                                                                                                      _
                                                                                                                      =>
                                                                                                                      failwith
                                                                                                                        "%s - Unexpected period kind"
                                                                                                                          %
                                                                                                                          string
                                                                                                                        __LOC__
                                                                                                                    end))
                                                                                                                (fun
                                                                                                                  function_parameter
                                                                                                                  =>
                                                                                                                  let
                                                                                                                    'tt :=
                                                                                                                    function_parameter
                                                                                                                    in
                                                                                                                  op_gtgteqquestion
                                                                                                                    (op_startypeminuserrorstar
                                                                                                                      op_startypeminuserrorstar)
                                                                                                                    (fun
                                                                                                                      v
                                                                                                                      =>
                                                                                                                      op_gtgteqquestion
                                                                                                                        (op_startypeminuserrorstar
                                                                                                                          __LOC__
                                                                                                                          Voting_period.equal
                                                                                                                          "Unexpected period"
                                                                                                                            %
                                                                                                                            string
                                                                                                                          Voting_period.pp
                                                                                                                          v
                                                                                                                          (succ
                                                                                                                            root))
                                                                                                                        (fun
                                                                                                                          function_parameter
                                                                                                                          =>
                                                                                                                          let
                                                                                                                            'tt :=
                                                                                                                            function_parameter
                                                                                                                            in
                                                                                                                          op_gtgteqquestion
                                                                                                                            (op_gtgteqquestion
                                                                                                                              (op_startypeminuserrorstar
                                                                                                                                op_startypeminuserrorstar)
                                                                                                                              (fun
                                                                                                                                function_parameter
                                                                                                                                =>
                                                                                                                                match
                                                                                                                                  function_parameter
                                                                                                                                  with
                                                                                                                                |
                                                                                                                                  []
                                                                                                                                  =>
                                                                                                                                  failwith
                                                                                                                                    "%s - Unexpected empty listings"
                                                                                                                                      %
                                                                                                                                      string
                                                                                                                                    __LOC__
                                                                                                                                |
                                                                                                                                  _
                                                                                                                                  =>
                                                                                                                                  return_unit
                                                                                                                                end))
                                                                                                                            (fun
                                                                                                                              function_parameter
                                                                                                                              =>
                                                                                                                              let
                                                                                                                                'tt :=
                                                                                                                                function_parameter
                                                                                                                                in
                                                                                                                              op_gtgteqquestion
                                                                                                                                (get_delegates_and_rolls_from_listings
                                                                                                                                  b)
                                                                                                                                (fun
                                                                                                                                  function_parameter
                                                                                                                                  =>
                                                                                                                                  let
                                                                                                                                    '(delegates_p2,
                                                                                                                                      rolls_p2) :=
                                                                                                                                    function_parameter
                                                                                                                                    in
                                                                                                                                  op_gtgteqquestion
                                                                                                                                    (op_startypeminuserrorstar
                                                                                                                                      op_startypeminuserrorstar)
                                                                                                                                    (fun
                                                                                                                                      ps
                                                                                                                                      =>
                                                                                                                                      op_gtgteqquestion
                                                                                                                                        (if
                                                                                                                                          Environment.Protocol_hash.Map.is_empty
                                                                                                                                            ps
                                                                                                                                          then
                                                                                                                                          return_unit
                                                                                                                                        else
                                                                                                                                          failwith
                                                                                                                                            "%s - Unexpected proposals"
                                                                                                                                              %
                                                                                                                                              string
                                                                                                                                            __LOC__)
                                                                                                                                        (fun
                                                                                                                                          function_parameter
                                                                                                                                          =>
                                                                                                                                          let
                                                                                                                                            'tt :=
                                                                                                                                            function_parameter
                                                                                                                                            in
                                                                                                                                          op_gtgteqquestion
                                                                                                                                            (op_gtgteqquestion
                                                                                                                                              (op_startypeminuserrorstar
                                                                                                                                                op_startypeminuserrorstar)
                                                                                                                                              (fun
                                                                                                                                                function_parameter
                                                                                                                                                =>
                                                                                                                                                match
                                                                                                                                                  function_parameter
                                                                                                                                                  with
                                                                                                                                                |
                                                                                                                                                  Some
                                                                                                                                                    v
                                                                                                                                                  =>
                                                                                                                                                  if
                                                                                                                                                    Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.equal)
                                                                                                                                                      Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.zero)
                                                                                                                                                      v
                                                                                                                                                    then
                                                                                                                                                    return_unit
                                                                                                                                                  else
                                                                                                                                                    failwith
                                                                                                                                                      "%s - Wrong proposal"
                                                                                                                                                        %
                                                                                                                                                        string
                                                                                                                                                      __LOC__
                                                                                                                                                |
                                                                                                                                                  None
                                                                                                                                                  =>
                                                                                                                                                  failwith
                                                                                                                                                    "%s - Missing proposal"
                                                                                                                                                      %
                                                                                                                                                      string
                                                                                                                                                    __LOC__
                                                                                                                                                end))
                                                                                                                                            (fun
                                                                                                                                              function_parameter
                                                                                                                                              =>
                                                                                                                                              let
                                                                                                                                                'tt :=
                                                                                                                                                function_parameter
                                                                                                                                                in
                                                                                                                                              op_gtgteqquestion
                                                                                                                                                (map_s
                                                                                                                                                  (fun
                                                                                                                                                    del
                                                                                                                                                    =>
                                                                                                                                                    op_startypeminuserrorstar
                                                                                                                                                      op_startypeminuserrorstar
                                                                                                                                                      del
                                                                                                                                                      Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.zero)
                                                                                                                                                      Tezos_protocol_alpha.Protocol.Alpha_context.Vote.Yay)
                                                                                                                                                  delegates_p2)
                                                                                                                                                (fun
                                                                                                                                                  operations
                                                                                                                                                  =>
                                                                                                                                                  op_gtgteqquestion
                                                                                                                                                    (op_startypeminuserrorstar
                                                                                                                                                      operations
                                                                                                                                                      b)
                                                                                                                                                    (fun
                                                                                                                                                      b
                                                                                                                                                      =>
                                                                                                                                                      op_gtgteqquestion
                                                                                                                                                        (op_startypeminuserrorstar
                                                                                                                                                          op_startypeminuserrorstar
                                                                                                                                                          del1
                                                                                                                                                          Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.zero)
                                                                                                                                                          Tezos_protocol_alpha.Protocol.Alpha_context.Vote.Nay)
                                                                                                                                                        (fun
                                                                                                                                                          op
                                                                                                                                                          =>
                                                                                                                                                          op_gtgteq
                                                                                                                                                            (op_startypeminuserrorstar
                                                                                                                                                              (cons
                                                                                                                                                                op
                                                                                                                                                                [])
                                                                                                                                                              b)
                                                                                                                                                            (fun
                                                                                                                                                              res
                                                                                                                                                              =>
                                                                                                                                                              op_gtgteqquestion
                                                                                                                                                                (op_startypeminuserrorstar
                                                                                                                                                                  __LOC__
                                                                                                                                                                  res
                                                                                                                                                                  (fun
                                                                                                                                                                    function_parameter
                                                                                                                                                                    =>
                                                                                                                                                                    match
                                                                                                                                                                      function_parameter
                                                                                                                                                                      with
                                                                                                                                                                    |
                                                                                                                                                                      Tezos_protocol_environment_alpha__Environment.Error_monad.Unauthorized_ballot
                                                                                                                                                                      =>
                                                                                                                                                                      true
                                                                                                                                                                    |
                                                                                                                                                                      _
                                                                                                                                                                      =>
                                                                                                                                                                      false
                                                                                                                                                                    end))
                                                                                                                                                                (fun
                                                                                                                                                                  function_parameter
                                                                                                                                                                  =>
                                                                                                                                                                  let
                                                                                                                                                                    'tt :=
                                                                                                                                                                    function_parameter
                                                                                                                                                                    in
                                                                                                                                                                  op_gtgteqquestion
                                                                                                                                                                    (fold_left_s
                                                                                                                                                                      (fun
                                                                                                                                                                        v
                                                                                                                                                                        =>
                                                                                                                                                                        fun
                                                                                                                                                                          acc
                                                                                                                                                                          =>
                                                                                                                                                                          __return
                                                                                                                                                                            (add
                                                                                                                                                                              v
                                                                                                                                                                              acc))
                                                                                                                                                                      (* ❌ Constant of type int32 is converted to int *)
                                                                                                                                                                      0
                                                                                                                                                                      rolls_p2)
                                                                                                                                                                    (fun
                                                                                                                                                                      rolls_sum
                                                                                                                                                                      =>
                                                                                                                                                                      op_gtgteqquestion
                                                                                                                                                                        (op_startypeminuserrorstar
                                                                                                                                                                          op_startypeminuserrorstar)
                                                                                                                                                                        (fun
                                                                                                                                                                          v
                                                                                                                                                                          =>
                                                                                                                                                                          op_gtgteqquestion
                                                                                                                                                                            (op_startypeminuserrorstar
                                                                                                                                                                              __LOC__
                                                                                                                                                                              ballots_equal
                                                                                                                                                                              "Unexpected ballots"
                                                                                                                                                                                %
                                                                                                                                                                                string
                                                                                                                                                                              ballots_pp
                                                                                                                                                                              v
                                                                                                                                                                              {|
                                                                                                                                                                                yay :=
                                                                                                                                                                                  rolls_sum;
                                                                                                                                                                                nay :=
                                                                                                                                                                                  (* ❌ Constant of type int32 is converted to int *)
                                                                                                                                                                                  0;
                                                                                                                                                                                pass :=
                                                                                                                                                                                  (* ❌ Constant of type int32 is converted to int *)
                                                                                                                                                                                  0
                                                                                                                                                                                |})
                                                                                                                                                                            (fun
                                                                                                                                                                              function_parameter
                                                                                                                                                                              =>
                                                                                                                                                                              let
                                                                                                                                                                                'tt :=
                                                                                                                                                                                function_parameter
                                                                                                                                                                                in
                                                                                                                                                                              op_gtgteqquestion
                                                                                                                                                                                (op_gtgteqquestion
                                                                                                                                                                                  (op_startypeminuserrorstar
                                                                                                                                                                                    op_startypeminuserrorstar)
                                                                                                                                                                                  (fun
                                                                                                                                                                                    function_parameter
                                                                                                                                                                                    =>
                                                                                                                                                                                    match
                                                                                                                                                                                      function_parameter
                                                                                                                                                                                      with
                                                                                                                                                                                    |
                                                                                                                                                                                      []
                                                                                                                                                                                      =>
                                                                                                                                                                                      failwith
                                                                                                                                                                                        "%s - Unexpected empty ballot list"
                                                                                                                                                                                          %
                                                                                                                                                                                          string
                                                                                                                                                                                        __LOC__
                                                                                                                                                                                    |
                                                                                                                                                                                      l
                                                                                                                                                                                      =>
                                                                                                                                                                                      iter_s
                                                                                                                                                                                        (fun
                                                                                                                                                                                          delegate
                                                                                                                                                                                          =>
                                                                                                                                                                                          op_gtgteqquestion
                                                                                                                                                                                            (op_startypeminuserrorstar
                                                                                                                                                                                              delegate)
                                                                                                                                                                                            (fun
                                                                                                                                                                                              pkh
                                                                                                                                                                                              =>
                                                                                                                                                                                              match
                                                                                                                                                                                                List.find_opt
                                                                                                                                                                                                  (fun
                                                                                                                                                                                                    function_parameter
                                                                                                                                                                                                    =>
                                                                                                                                                                                                    let
                                                                                                                                                                                                      '(del,
                                                                                                                                                                                                        _) :=
                                                                                                                                                                                                      function_parameter
                                                                                                                                                                                                      in
                                                                                                                                                                                                    op_startypeminuserrorstar
                                                                                                                                                                                                      del
                                                                                                                                                                                                      pkh)
                                                                                                                                                                                                  l
                                                                                                                                                                                                with
                                                                                                                                                                                              |
                                                                                                                                                                                                None
                                                                                                                                                                                                =>
                                                                                                                                                                                                failwith
                                                                                                                                                                                                  "%s - Missing delegate"
                                                                                                                                                                                                    %
                                                                                                                                                                                                    string
                                                                                                                                                                                                  __LOC__
                                                                                                                                                                                              |
                                                                                                                                                                                                Some
                                                                                                                                                                                                  (_,
                                                                                                                                                                                                    Tezos_protocol_alpha.Protocol.Alpha_context.Vote.Yay)
                                                                                                                                                                                                =>
                                                                                                                                                                                                return_unit
                                                                                                                                                                                              |
                                                                                                                                                                                                Some
                                                                                                                                                                                                  _
                                                                                                                                                                                                =>
                                                                                                                                                                                                failwith
                                                                                                                                                                                                  "%s - Wrong ballot"
                                                                                                                                                                                                    %
                                                                                                                                                                                                    string
                                                                                                                                                                                                  __LOC__
                                                                                                                                                                                              end))
                                                                                                                                                                                        delegates_p2
                                                                                                                                                                                    end))
                                                                                                                                                                                (fun
                                                                                                                                                                                  function_parameter
                                                                                                                                                                                  =>
                                                                                                                                                                                  let
                                                                                                                                                                                    'tt :=
                                                                                                                                                                                    function_parameter
                                                                                                                                                                                    in
                                                                                                                                                                                  op_gtgteqquestion
                                                                                                                                                                                    (op_startypeminuserrorstar
                                                                                                                                                                                      (op_minus
                                                                                                                                                                                        (Int32.to_int
                                                                                                                                                                                          op_startypeminuserrorstar)
                                                                                                                                                                                        1)
                                                                                                                                                                                      b)
                                                                                                                                                                                    (fun
                                                                                                                                                                                      b
                                                                                                                                                                                      =>
                                                                                                                                                                                      op_gtgteqquestion
                                                                                                                                                                                        (op_gtgteqquestion
                                                                                                                                                                                          (op_startypeminuserrorstar
                                                                                                                                                                                            op_startypeminuserrorstar)
                                                                                                                                                                                          (fun
                                                                                                                                                                                            function_parameter
                                                                                                                                                                                            =>
                                                                                                                                                                                            match
                                                                                                                                                                                              function_parameter
                                                                                                                                                                                              with
                                                                                                                                                                                            |
                                                                                                                                                                                              _
                                                                                                                                                                                              =>
                                                                                                                                                                                              return_unit
                                                                                                                                                                                            |
                                                                                                                                                                                              _
                                                                                                                                                                                              =>
                                                                                                                                                                                              failwith
                                                                                                                                                                                                "%s - Unexpected period kind"
                                                                                                                                                                                                  %
                                                                                                                                                                                                  string
                                                                                                                                                                                                __LOC__
                                                                                                                                                                                            end))
                                                                                                                                                                                        (fun
                                                                                                                                                                                          function_parameter
                                                                                                                                                                                          =>
                                                                                                                                                                                          let
                                                                                                                                                                                            'tt :=
                                                                                                                                                                                            function_parameter
                                                                                                                                                                                            in
                                                                                                                                                                                          op_gtgteqquestion
                                                                                                                                                                                            (op_startypeminuserrorstar
                                                                                                                                                                                              op_startypeminuserrorstar)
                                                                                                                                                                                            (fun
                                                                                                                                                                                              v
                                                                                                                                                                                              =>
                                                                                                                                                                                              op_gtgteqquestion
                                                                                                                                                                                                (op_startypeminuserrorstar
                                                                                                                                                                                                  __LOC__
                                                                                                                                                                                                  Voting_period.equal
                                                                                                                                                                                                  "Unexpected period"
                                                                                                                                                                                                    %
                                                                                                                                                                                                    string
                                                                                                                                                                                                  Voting_period.pp
                                                                                                                                                                                                  v
                                                                                                                                                                                                  (succ
                                                                                                                                                                                                    (succ
                                                                                                                                                                                                      root)))
                                                                                                                                                                                                (fun
                                                                                                                                                                                                  function_parameter
                                                                                                                                                                                                  =>
                                                                                                                                                                                                  let
                                                                                                                                                                                                    'tt :=
                                                                                                                                                                                                    function_parameter
                                                                                                                                                                                                    in
                                                                                                                                                                                                  op_gtgteqquestion
                                                                                                                                                                                                    (op_startypeminuserrorstar
                                                                                                                                                                                                      op_startypeminuserrorstar)
                                                                                                                                                                                                    (fun
                                                                                                                                                                                                      v
                                                                                                                                                                                                      =>
                                                                                                                                                                                                      op_gtgteqquestion
                                                                                                                                                                                                        (op_startypeminuserrorstar
                                                                                                                                                                                                          __LOC__
                                                                                                                                                                                                          ballots_equal
                                                                                                                                                                                                          "Unexpected ballots"
                                                                                                                                                                                                            %
                                                                                                                                                                                                            string
                                                                                                                                                                                                          ballots_pp
                                                                                                                                                                                                          v
                                                                                                                                                                                                          ballots_zero)
                                                                                                                                                                                                        (fun
                                                                                                                                                                                                          function_parameter
                                                                                                                                                                                                          =>
                                                                                                                                                                                                          let
                                                                                                                                                                                                            'tt :=
                                                                                                                                                                                                            function_parameter
                                                                                                                                                                                                            in
                                                                                                                                                                                                          op_gtgteqquestion
                                                                                                                                                                                                            (op_gtgteqquestion
                                                                                                                                                                                                              (op_startypeminuserrorstar
                                                                                                                                                                                                                op_startypeminuserrorstar)
                                                                                                                                                                                                              (fun
                                                                                                                                                                                                                function_parameter
                                                                                                                                                                                                                =>
                                                                                                                                                                                                                match
                                                                                                                                                                                                                  function_parameter
                                                                                                                                                                                                                  with
                                                                                                                                                                                                                |
                                                                                                                                                                                                                  []
                                                                                                                                                                                                                  =>
                                                                                                                                                                                                                  return_unit
                                                                                                                                                                                                                |
                                                                                                                                                                                                                  _
                                                                                                                                                                                                                  =>
                                                                                                                                                                                                                  failwith
                                                                                                                                                                                                                    "%s - Unexpected listings"
                                                                                                                                                                                                                      %
                                                                                                                                                                                                                      string
                                                                                                                                                                                                                    __LOC__
                                                                                                                                                                                                                end))
                                                                                                                                                                                                            (fun
                                                                                                                                                                                                              function_parameter
                                                                                                                                                                                                              =>
                                                                                                                                                                                                              let
                                                                                                                                                                                                                'tt :=
                                                                                                                                                                                                                function_parameter
                                                                                                                                                                                                                in
                                                                                                                                                                                                              op_gtgteqquestion
                                                                                                                                                                                                                (op_startypeminuserrorstar
                                                                                                                                                                                                                  (Int32.to_int
                                                                                                                                                                                                                    op_startypeminuserrorstar)
                                                                                                                                                                                                                  b)
                                                                                                                                                                                                                (fun
                                                                                                                                                                                                                  b
                                                                                                                                                                                                                  =>
                                                                                                                                                                                                                  op_gtgteqquestion
                                                                                                                                                                                                                    (op_gtgteqquestion
                                                                                                                                                                                                                      (op_startypeminuserrorstar
                                                                                                                                                                                                                        op_startypeminuserrorstar)
                                                                                                                                                                                                                      (fun
                                                                                                                                                                                                                        function_parameter
                                                                                                                                                                                                                        =>
                                                                                                                                                                                                                        match
                                                                                                                                                                                                                          function_parameter
                                                                                                                                                                                                                          with
                                                                                                                                                                                                                        |
                                                                                                                                                                                                                          _
                                                                                                                                                                                                                          =>
                                                                                                                                                                                                                          return_unit
                                                                                                                                                                                                                        |
                                                                                                                                                                                                                          _
                                                                                                                                                                                                                          =>
                                                                                                                                                                                                                          failwith
                                                                                                                                                                                                                            "%s - Unexpected period kind"
                                                                                                                                                                                                                              %
                                                                                                                                                                                                                              string
                                                                                                                                                                                                                            __LOC__
                                                                                                                                                                                                                        end))
                                                                                                                                                                                                                    (fun
                                                                                                                                                                                                                      function_parameter
                                                                                                                                                                                                                      =>
                                                                                                                                                                                                                      let
                                                                                                                                                                                                                        'tt :=
                                                                                                                                                                                                                        function_parameter
                                                                                                                                                                                                                        in
                                                                                                                                                                                                                      op_gtgteqquestion
                                                                                                                                                                                                                        (op_startypeminuserrorstar
                                                                                                                                                                                                                          op_startypeminuserrorstar)
                                                                                                                                                                                                                        (fun
                                                                                                                                                                                                                          v
                                                                                                                                                                                                                          =>
                                                                                                                                                                                                                          op_gtgteqquestion
                                                                                                                                                                                                                            (op_startypeminuserrorstar
                                                                                                                                                                                                                              __LOC__
                                                                                                                                                                                                                              Voting_period.equal
                                                                                                                                                                                                                              "Unexpected period"
                                                                                                                                                                                                                                %
                                                                                                                                                                                                                                string
                                                                                                                                                                                                                              Voting_period.pp
                                                                                                                                                                                                                              v
                                                                                                                                                                                                                              (succ
                                                                                                                                                                                                                                (succ
                                                                                                                                                                                                                                  (succ
                                                                                                                                                                                                                                    root))))
                                                                                                                                                                                                                            (fun
                                                                                                                                                                                                                              function_parameter
                                                                                                                                                                                                                              =>
                                                                                                                                                                                                                              let
                                                                                                                                                                                                                                'tt :=
                                                                                                                                                                                                                                function_parameter
                                                                                                                                                                                                                                in
                                                                                                                                                                                                                              op_gtgteqquestion
                                                                                                                                                                                                                                (op_gtgteqquestion
                                                                                                                                                                                                                                  (op_startypeminuserrorstar
                                                                                                                                                                                                                                    op_startypeminuserrorstar)
                                                                                                                                                                                                                                  (fun
                                                                                                                                                                                                                                    function_parameter
                                                                                                                                                                                                                                    =>
                                                                                                                                                                                                                                    match
                                                                                                                                                                                                                                      function_parameter
                                                                                                                                                                                                                                      with
                                                                                                                                                                                                                                    |
                                                                                                                                                                                                                                      []
                                                                                                                                                                                                                                      =>
                                                                                                                                                                                                                                      failwith
                                                                                                                                                                                                                                        "%s - Unexpected empty listings"
                                                                                                                                                                                                                                          %
                                                                                                                                                                                                                                          string
                                                                                                                                                                                                                                        __LOC__
                                                                                                                                                                                                                                    |
                                                                                                                                                                                                                                      _
                                                                                                                                                                                                                                      =>
                                                                                                                                                                                                                                      return_unit
                                                                                                                                                                                                                                    end))
                                                                                                                                                                                                                                (fun
                                                                                                                                                                                                                                  function_parameter
                                                                                                                                                                                                                                  =>
                                                                                                                                                                                                                                  let
                                                                                                                                                                                                                                    'tt :=
                                                                                                                                                                                                                                    function_parameter
                                                                                                                                                                                                                                    in
                                                                                                                                                                                                                                  op_gtgteqquestion
                                                                                                                                                                                                                                    (get_delegates_and_rolls_from_listings
                                                                                                                                                                                                                                      b)
                                                                                                                                                                                                                                    (fun
                                                                                                                                                                                                                                      function_parameter
                                                                                                                                                                                                                                      =>
                                                                                                                                                                                                                                      let
                                                                                                                                                                                                                                        '(delegates_p4,
                                                                                                                                                                                                                                          rolls_p4) :=
                                                                                                                                                                                                                                        function_parameter
                                                                                                                                                                                                                                        in
                                                                                                                                                                                                                                      op_gtgteqquestion
                                                                                                                                                                                                                                        (op_startypeminuserrorstar
                                                                                                                                                                                                                                          op_startypeminuserrorstar)
                                                                                                                                                                                                                                        (fun
                                                                                                                                                                                                                                          ps
                                                                                                                                                                                                                                          =>
                                                                                                                                                                                                                                          op_gtgteqquestion
                                                                                                                                                                                                                                            (if
                                                                                                                                                                                                                                              Environment.Protocol_hash.Map.is_empty
                                                                                                                                                                                                                                                ps
                                                                                                                                                                                                                                              then
                                                                                                                                                                                                                                              return_unit
                                                                                                                                                                                                                                            else
                                                                                                                                                                                                                                              failwith
                                                                                                                                                                                                                                                "%s - Unexpected proposals"
                                                                                                                                                                                                                                                  %
                                                                                                                                                                                                                                                  string
                                                                                                                                                                                                                                                __LOC__)
                                                                                                                                                                                                                                            (fun
                                                                                                                                                                                                                                              function_parameter
                                                                                                                                                                                                                                              =>
                                                                                                                                                                                                                                              let
                                                                                                                                                                                                                                                'tt :=
                                                                                                                                                                                                                                                function_parameter
                                                                                                                                                                                                                                                in
                                                                                                                                                                                                                                              op_gtgteqquestion
                                                                                                                                                                                                                                                (op_gtgteqquestion
                                                                                                                                                                                                                                                  (op_startypeminuserrorstar
                                                                                                                                                                                                                                                    op_startypeminuserrorstar)
                                                                                                                                                                                                                                                  (fun
                                                                                                                                                                                                                                                    function_parameter
                                                                                                                                                                                                                                                    =>
                                                                                                                                                                                                                                                    match
                                                                                                                                                                                                                                                      function_parameter
                                                                                                                                                                                                                                                      with
                                                                                                                                                                                                                                                    |
                                                                                                                                                                                                                                                      Some
                                                                                                                                                                                                                                                        v
                                                                                                                                                                                                                                                      =>
                                                                                                                                                                                                                                                      if
                                                                                                                                                                                                                                                        Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.equal)
                                                                                                                                                                                                                                                          Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.zero)
                                                                                                                                                                                                                                                          v
                                                                                                                                                                                                                                                        then
                                                                                                                                                                                                                                                        return_unit
                                                                                                                                                                                                                                                      else
                                                                                                                                                                                                                                                        failwith
                                                                                                                                                                                                                                                          "%s - Wrong proposal"
                                                                                                                                                                                                                                                            %
                                                                                                                                                                                                                                                            string
                                                                                                                                                                                                                                                          __LOC__
                                                                                                                                                                                                                                                    |
                                                                                                                                                                                                                                                      None
                                                                                                                                                                                                                                                      =>
                                                                                                                                                                                                                                                      failwith
                                                                                                                                                                                                                                                        "%s - Missing proposal"
                                                                                                                                                                                                                                                          %
                                                                                                                                                                                                                                                          string
                                                                                                                                                                                                                                                        __LOC__
                                                                                                                                                                                                                                                    end))
                                                                                                                                                                                                                                                (fun
                                                                                                                                                                                                                                                  function_parameter
                                                                                                                                                                                                                                                  =>
                                                                                                                                                                                                                                                  let
                                                                                                                                                                                                                                                    'tt :=
                                                                                                                                                                                                                                                    function_parameter
                                                                                                                                                                                                                                                    in
                                                                                                                                                                                                                                                  op_gtgteqquestion
                                                                                                                                                                                                                                                    (map_s
                                                                                                                                                                                                                                                      (fun
                                                                                                                                                                                                                                                        del
                                                                                                                                                                                                                                                        =>
                                                                                                                                                                                                                                                        op_startypeminuserrorstar
                                                                                                                                                                                                                                                          op_startypeminuserrorstar
                                                                                                                                                                                                                                                          del
                                                                                                                                                                                                                                                          Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.zero)
                                                                                                                                                                                                                                                          Tezos_protocol_alpha.Protocol.Alpha_context.Vote.Yay)
                                                                                                                                                                                                                                                      delegates_p4)
                                                                                                                                                                                                                                                    (fun
                                                                                                                                                                                                                                                      operations
                                                                                                                                                                                                                                                      =>
                                                                                                                                                                                                                                                      op_gtgteqquestion
                                                                                                                                                                                                                                                        (op_startypeminuserrorstar
                                                                                                                                                                                                                                                          operations
                                                                                                                                                                                                                                                          b)
                                                                                                                                                                                                                                                        (fun
                                                                                                                                                                                                                                                          b
                                                                                                                                                                                                                                                          =>
                                                                                                                                                                                                                                                          op_gtgteqquestion
                                                                                                                                                                                                                                                            (fold_left_s
                                                                                                                                                                                                                                                              (fun
                                                                                                                                                                                                                                                                v
                                                                                                                                                                                                                                                                =>
                                                                                                                                                                                                                                                                fun
                                                                                                                                                                                                                                                                  acc
                                                                                                                                                                                                                                                                  =>
                                                                                                                                                                                                                                                                  __return
                                                                                                                                                                                                                                                                    (add
                                                                                                                                                                                                                                                                      v
                                                                                                                                                                                                                                                                      acc))
                                                                                                                                                                                                                                                              (* ❌ Constant of type int32 is converted to int *)
                                                                                                                                                                                                                                                              0
                                                                                                                                                                                                                                                              rolls_p4)
                                                                                                                                                                                                                                                            (fun
                                                                                                                                                                                                                                                              rolls_sum
                                                                                                                                                                                                                                                              =>
                                                                                                                                                                                                                                                              op_gtgteqquestion
                                                                                                                                                                                                                                                                (op_startypeminuserrorstar
                                                                                                                                                                                                                                                                  op_startypeminuserrorstar)
                                                                                                                                                                                                                                                                (fun
                                                                                                                                                                                                                                                                  v
                                                                                                                                                                                                                                                                  =>
                                                                                                                                                                                                                                                                  op_gtgteqquestion
                                                                                                                                                                                                                                                                    (op_startypeminuserrorstar
                                                                                                                                                                                                                                                                      __LOC__
                                                                                                                                                                                                                                                                      ballots_equal
                                                                                                                                                                                                                                                                      "Unexpected ballots"
                                                                                                                                                                                                                                                                        %
                                                                                                                                                                                                                                                                        string
                                                                                                                                                                                                                                                                      ballots_pp
                                                                                                                                                                                                                                                                      v
                                                                                                                                                                                                                                                                      {|
                                                                                                                                                                                                                                                                        yay :=
                                                                                                                                                                                                                                                                          rolls_sum;
                                                                                                                                                                                                                                                                        nay :=
                                                                                                                                                                                                                                                                          (* ❌ Constant of type int32 is converted to int *)
                                                                                                                                                                                                                                                                          0;
                                                                                                                                                                                                                                                                        pass :=
                                                                                                                                                                                                                                                                          (* ❌ Constant of type int32 is converted to int *)
                                                                                                                                                                                                                                                                          0
                                                                                                                                                                                                                                                                        |})
                                                                                                                                                                                                                                                                    (fun
                                                                                                                                                                                                                                                                      function_parameter
                                                                                                                                                                                                                                                                      =>
                                                                                                                                                                                                                                                                      let
                                                                                                                                                                                                                                                                        'tt :=
                                                                                                                                                                                                                                                                        function_parameter
                                                                                                                                                                                                                                                                        in
                                                                                                                                                                                                                                                                      op_gtgteqquestion
                                                                                                                                                                                                                                                                        (op_gtgteqquestion
                                                                                                                                                                                                                                                                          (op_startypeminuserrorstar
                                                                                                                                                                                                                                                                            op_startypeminuserrorstar)
                                                                                                                                                                                                                                                                          (fun
                                                                                                                                                                                                                                                                            function_parameter
                                                                                                                                                                                                                                                                            =>
                                                                                                                                                                                                                                                                            match
                                                                                                                                                                                                                                                                              function_parameter
                                                                                                                                                                                                                                                                              with
                                                                                                                                                                                                                                                                            |
                                                                                                                                                                                                                                                                              []
                                                                                                                                                                                                                                                                              =>
                                                                                                                                                                                                                                                                              failwith
                                                                                                                                                                                                                                                                                "%s - Unexpected empty ballot list"
                                                                                                                                                                                                                                                                                  %
                                                                                                                                                                                                                                                                                  string
                                                                                                                                                                                                                                                                                __LOC__
                                                                                                                                                                                                                                                                            |
                                                                                                                                                                                                                                                                              l
                                                                                                                                                                                                                                                                              =>
                                                                                                                                                                                                                                                                              iter_s
                                                                                                                                                                                                                                                                                (fun
                                                                                                                                                                                                                                                                                  delegate
                                                                                                                                                                                                                                                                                  =>
                                                                                                                                                                                                                                                                                  op_gtgteqquestion
                                                                                                                                                                                                                                                                                    (op_startypeminuserrorstar
                                                                                                                                                                                                                                                                                      delegate)
                                                                                                                                                                                                                                                                                    (fun
                                                                                                                                                                                                                                                                                      pkh
                                                                                                                                                                                                                                                                                      =>
                                                                                                                                                                                                                                                                                      match
                                                                                                                                                                                                                                                                                        List.find_opt
                                                                                                                                                                                                                                                                                          (fun
                                                                                                                                                                                                                                                                                            function_parameter
                                                                                                                                                                                                                                                                                            =>
                                                                                                                                                                                                                                                                                            let
                                                                                                                                                                                                                                                                                              '(del,
                                                                                                                                                                                                                                                                                                _) :=
                                                                                                                                                                                                                                                                                              function_parameter
                                                                                                                                                                                                                                                                                              in
                                                                                                                                                                                                                                                                                            op_startypeminuserrorstar
                                                                                                                                                                                                                                                                                              del
                                                                                                                                                                                                                                                                                              pkh)
                                                                                                                                                                                                                                                                                          l
                                                                                                                                                                                                                                                                                        with
                                                                                                                                                                                                                                                                                      |
                                                                                                                                                                                                                                                                                        None
                                                                                                                                                                                                                                                                                        =>
                                                                                                                                                                                                                                                                                        failwith
                                                                                                                                                                                                                                                                                          "%s - Missing delegate"
                                                                                                                                                                                                                                                                                            %
                                                                                                                                                                                                                                                                                            string
                                                                                                                                                                                                                                                                                          __LOC__
                                                                                                                                                                                                                                                                                      |
                                                                                                                                                                                                                                                                                        Some
                                                                                                                                                                                                                                                                                          (_,
                                                                                                                                                                                                                                                                                            Tezos_protocol_alpha.Protocol.Alpha_context.Vote.Yay)
                                                                                                                                                                                                                                                                                        =>
                                                                                                                                                                                                                                                                                        return_unit
                                                                                                                                                                                                                                                                                      |
                                                                                                                                                                                                                                                                                        Some
                                                                                                                                                                                                                                                                                          _
                                                                                                                                                                                                                                                                                        =>
                                                                                                                                                                                                                                                                                        failwith
                                                                                                                                                                                                                                                                                          "%s - Wrong ballot"
                                                                                                                                                                                                                                                                                            %
                                                                                                                                                                                                                                                                                            string
                                                                                                                                                                                                                                                                                          __LOC__
                                                                                                                                                                                                                                                                                      end))
                                                                                                                                                                                                                                                                                delegates_p4
                                                                                                                                                                                                                                                                            end))
                                                                                                                                                                                                                                                                        (fun
                                                                                                                                                                                                                                                                          function_parameter
                                                                                                                                                                                                                                                                          =>
                                                                                                                                                                                                                                                                          let
                                                                                                                                                                                                                                                                            'tt :=
                                                                                                                                                                                                                                                                            function_parameter
                                                                                                                                                                                                                                                                            in
                                                                                                                                                                                                                                                                          op_gtgteqquestion
                                                                                                                                                                                                                                                                            (op_startypeminuserrorstar
                                                                                                                                                                                                                                                                              (op_minus
                                                                                                                                                                                                                                                                                (to_int
                                                                                                                                                                                                                                                                                  op_startypeminuserrorstar)
                                                                                                                                                                                                                                                                                1)
                                                                                                                                                                                                                                                                              b)
                                                                                                                                                                                                                                                                            (fun
                                                                                                                                                                                                                                                                              b
                                                                                                                                                                                                                                                                              =>
                                                                                                                                                                                                                                                                              op_gtgteq
                                                                                                                                                                                                                                                                                (op_startypeminuserrorstar
                                                                                                                                                                                                                                                                                  b)
                                                                                                                                                                                                                                                                                (fun
                                                                                                                                                                                                                                                                                  p
                                                                                                                                                                                                                                                                                  =>
                                                                                                                                                                                                                                                                                  op_gtgteqquestion
                                                                                                                                                                                                                                                                                    (op_startypeminuserrorstar
                                                                                                                                                                                                                                                                                      __LOC__
                                                                                                                                                                                                                                                                                      Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.equal)
                                                                                                                                                                                                                                                                                      "Unexpected proposal"
                                                                                                                                                                                                                                                                                        %
                                                                                                                                                                                                                                                                                        string
                                                                                                                                                                                                                                                                                      Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.pp)
                                                                                                                                                                                                                                                                                      p
                                                                                                                                                                                                                                                                                      Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.zero))
                                                                                                                                                                                                                                                                                    (fun
                                                                                                                                                                                                                                                                                      function_parameter
                                                                                                                                                                                                                                                                                      =>
                                                                                                                                                                                                                                                                                      let
                                                                                                                                                                                                                                                                                        'tt :=
                                                                                                                                                                                                                                                                                        function_parameter
                                                                                                                                                                                                                                                                                        in
                                                                                                                                                                                                                                                                                      return_unit))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))).

Definition get_smallest_prefix_voters_for_quorum {A : Type}
  (active_delegates : list A) (active_rolls : list int32)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult (list A)) :=
  op_gtgteqquestion
    (fold_left_s (fun v => fun acc => __return (add v acc))
      (* ❌ Constant of type int32 is converted to int *)
      0 active_rolls)
    (fun active_rolls_sum =>
      let fix loop {B : Type}
        (delegates : list B) (rolls : list int32) (sum : Z) (selected : list B)
        : list B :=
        match (delegates, rolls) with
        | ([], []) => selected
        | (cons del delegates, cons del_rolls rolls) =>
          if
            op_startypeminuserrorstar (op_star den sum)
              (op_startypeminuserrorstar
                (op_startypeminuserrorstar expected_qr_num
                  (Int32.to_float active_rolls_sum))) then
            loop delegates rolls (op_plus sum (Int32.to_int del_rolls))
              (cons del selected)
          else
            selected
        | (_, _) => []
        end in
      __return (loop active_delegates active_rolls 0 [])).

Definition get_expected_participation_ema
  (rolls : list int32) (voter_rolls : list int32)
  (old_participation_ema : int32)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z) :=
  let get_updated_participation_ema
    (old_participation_ema : int32) (participation : Z) : Z :=
    op_div
      (op_plus (op_star pr_ema_weight (Int32.to_int old_participation_ema))
        (op_star pr_num participation)) den in
  op_gtgteqquestion
    (fold_left_s (fun v => fun acc => __return (add v acc))
      (* ❌ Constant of type int32 is converted to int *)
      0 rolls)
    (fun rolls_sum =>
      op_gtgteqquestion
        (fold_left_s (fun v => fun acc => __return (add v acc))
          (* ❌ Constant of type int32 is converted to int *)
          0 voter_rolls)
        (fun voter_rolls_sum =>
          let participation :=
            op_div (op_star (Int32.to_int voter_rolls_sum) percent_mul)
              (Int32.to_int rolls_sum) in
          __return
            (get_updated_participation_ema old_participation_ema participation))).

Definition test_not_enough_quorum_in_testing_vote
  (num_delegates : Z) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  let min_proposal_quorum := op_atat of_int (op_div 10000 num_delegates) in
  op_gtgteqquestion
    (op_startypeminuserrorstar min_proposal_quorum num_delegates)
    (fun function_parameter =>
      let '(b, delegates) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
        (fun function_parameter =>
          let '_ := function_parameter in
          op_gtgteqquestion
            (op_gtgteqquestion
              (op_startypeminuserrorstar op_startypeminuserrorstar)
              (fun function_parameter =>
                match function_parameter with
                | _ => return_unit
                | _ => failwith "%s - Unexpected period kind" % string __LOC__
                end))
            (fun function_parameter =>
              let 'tt := function_parameter in
              let proposer := op_startypeminuserrorstar delegates 0 in
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar proposer
                  (cons
                    Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.zero)
                    []))
                (fun ops =>
                  op_gtgteqquestion (op_startypeminuserrorstar (cons ops []) b)
                    (fun b =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar
                          (op_minus (Int32.to_int op_startypeminuserrorstar) 2)
                          b)
                        (fun b =>
                          op_gtgteqquestion
                            (op_gtgteqquestion
                              (op_startypeminuserrorstar
                                op_startypeminuserrorstar)
                              (fun function_parameter =>
                                match function_parameter with
                                | _ => return_unit
                                | _ =>
                                  failwith
                                    "%s - Unexpected period kind" % string
                                    __LOC__
                                end))
                            (fun function_parameter =>
                              let 'tt := function_parameter in
                              op_gtgteqquestion (op_startypeminuserrorstar b)
                                (fun initial_participation_ema =>
                                  op_gtgteqquestion
                                    (get_delegates_and_rolls_from_listings b)
                                    (fun function_parameter =>
                                      let '(delegates_p2, rolls_p2) :=
                                        function_parameter in
                                      op_gtgteqquestion
                                        (get_smallest_prefix_voters_for_quorum
                                          delegates_p2 rolls_p2)
                                        (fun voters =>
                                          let voters_without_quorum :=
                                            List.tl voters in
                                          op_gtgteqquestion
                                            (get_rolls b voters_without_quorum
                                              __LOC__)
                                            (fun voters_rolls_in_testing_vote =>
                                              op_gtgteqquestion
                                                (map_s
                                                  (fun del =>
                                                    op_startypeminuserrorstar
                                                      op_startypeminuserrorstar
                                                      del
                                                      Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.zero)
                                                      Tezos_protocol_alpha.Protocol.Alpha_context.Vote.Yay)
                                                  voters_without_quorum)
                                                (fun operations =>
                                                  op_gtgteqquestion
                                                    (op_startypeminuserrorstar
                                                      operations b)
                                                    (fun b =>
                                                      op_gtgteqquestion
                                                        (op_startypeminuserrorstar
                                                          (op_minus
                                                            (Int32.to_int
                                                              op_startypeminuserrorstar)
                                                            1) b)
                                                        (fun b =>
                                                          op_gtgteqquestion
                                                            (op_gtgteqquestion
                                                              (op_startypeminuserrorstar
                                                                op_startypeminuserrorstar)
                                                              (fun
                                                                function_parameter
                                                                =>
                                                                match
                                                                  function_parameter
                                                                  with
                                                                | _ =>
                                                                  return_unit
                                                                | _ =>
                                                                  failwith
                                                                    "%s - Unexpected period kind"
                                                                      % string
                                                                    __LOC__
                                                                end))
                                                            (fun
                                                              function_parameter
                                                              =>
                                                              let 'tt :=
                                                                function_parameter
                                                                in
                                                              op_gtgteqquestion
                                                                (get_expected_participation_ema
                                                                  rolls_p2
                                                                  voters_rolls_in_testing_vote
                                                                  initial_participation_ema)
                                                                (fun
                                                                  expected_participation_ema
                                                                  =>
                                                                  op_gtgteqquestion
                                                                    (op_startypeminuserrorstar
                                                                      b)
                                                                    (fun
                                                                      new_participation_ema
                                                                      =>
                                                                      op_gtgteqquestion
                                                                        (op_startypeminuserrorstar
                                                                          __LOC__
                                                                          expected_participation_ema
                                                                          (Int32.to_int
                                                                            new_participation_ema))
                                                                        (fun
                                                                          function_parameter
                                                                          =>
                                                                          let
                                                                            'tt :=
                                                                            function_parameter
                                                                            in
                                                                          return_unit)))))))))))))))))).

Definition test_not_enough_quorum_in_promotion_vote
  (num_delegates : Z) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  let min_proposal_quorum := op_atat of_int (op_div 10000 num_delegates) in
  op_gtgteqquestion
    (op_startypeminuserrorstar min_proposal_quorum num_delegates)
    (fun function_parameter =>
      let '(b, delegates) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
        (fun function_parameter =>
          let '_ := function_parameter in
          op_gtgteqquestion
            (op_gtgteqquestion
              (op_startypeminuserrorstar op_startypeminuserrorstar)
              (fun function_parameter =>
                match function_parameter with
                | _ => return_unit
                | _ => failwith "%s - Unexpected period kind" % string __LOC__
                end))
            (fun function_parameter =>
              let 'tt := function_parameter in
              let proposer := op_startypeminuserrorstar delegates 0 in
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar proposer
                  (cons
                    Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.zero)
                    []))
                (fun ops =>
                  op_gtgteqquestion (op_startypeminuserrorstar (cons ops []) b)
                    (fun b =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar
                          (op_minus (Int32.to_int op_startypeminuserrorstar) 2)
                          b)
                        (fun b =>
                          op_gtgteqquestion
                            (op_gtgteqquestion
                              (op_startypeminuserrorstar
                                op_startypeminuserrorstar)
                              (fun function_parameter =>
                                match function_parameter with
                                | _ => return_unit
                                | _ =>
                                  failwith
                                    "%s - Unexpected period kind" % string
                                    __LOC__
                                end))
                            (fun function_parameter =>
                              let 'tt := function_parameter in
                              op_gtgteqquestion
                                (get_delegates_and_rolls_from_listings b)
                                (fun function_parameter =>
                                  let '(delegates_p2, rolls_p2) :=
                                    function_parameter in
                                  op_gtgteqquestion
                                    (get_smallest_prefix_voters_for_quorum
                                      delegates_p2 rolls_p2)
                                    (fun voters =>
                                      op_gtgteqquestion
                                        (map_s
                                          (fun del =>
                                            op_startypeminuserrorstar
                                              op_startypeminuserrorstar del
                                              Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.zero)
                                              Tezos_protocol_alpha.Protocol.Alpha_context.Vote.Yay)
                                          voters)
                                        (fun operations =>
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar
                                              operations b)
                                            (fun b =>
                                              op_gtgteqquestion
                                                (op_startypeminuserrorstar
                                                  (op_minus
                                                    (Int32.to_int
                                                      op_startypeminuserrorstar)
                                                    1) b)
                                                (fun b =>
                                                  op_gtgteqquestion
                                                    (op_gtgteqquestion
                                                      (op_startypeminuserrorstar
                                                        op_startypeminuserrorstar)
                                                      (fun function_parameter =>
                                                        match function_parameter
                                                          with
                                                        | _ => return_unit
                                                        | _ =>
                                                          failwith
                                                            "%s - Unexpected period kind"
                                                              % string __LOC__
                                                        end))
                                                    (fun function_parameter =>
                                                      let 'tt :=
                                                        function_parameter in
                                                      op_gtgteqquestion
                                                        (op_startypeminuserrorstar
                                                          (Int32.to_int
                                                            op_startypeminuserrorstar)
                                                          b)
                                                        (fun b =>
                                                          op_gtgteqquestion
                                                            (op_gtgteqquestion
                                                              (op_startypeminuserrorstar
                                                                op_startypeminuserrorstar)
                                                              (fun
                                                                function_parameter
                                                                =>
                                                                match
                                                                  function_parameter
                                                                  with
                                                                | _ =>
                                                                  return_unit
                                                                | _ =>
                                                                  failwith
                                                                    "%s - Unexpected period kind"
                                                                      % string
                                                                    __LOC__
                                                                end))
                                                            (fun
                                                              function_parameter
                                                              =>
                                                              let 'tt :=
                                                                function_parameter
                                                                in
                                                              op_gtgteqquestion
                                                                (op_startypeminuserrorstar
                                                                  b)
                                                                (fun
                                                                  initial_participation_ema
                                                                  =>
                                                                  op_gtgteqquestion
                                                                    (get_delegates_and_rolls_from_listings
                                                                      b)
                                                                    (fun
                                                                      function_parameter
                                                                      =>
                                                                      let
                                                                        '(delegates_p4,
                                                                          rolls_p4) :=
                                                                        function_parameter
                                                                        in
                                                                      op_gtgteqquestion
                                                                        (get_smallest_prefix_voters_for_quorum
                                                                          delegates_p4
                                                                          rolls_p4)
                                                                        (fun
                                                                          voters
                                                                          =>
                                                                          let
                                                                            voters_without_quorum :=
                                                                            List.tl
                                                                              voters
                                                                            in
                                                                          op_gtgteqquestion
                                                                            (get_rolls
                                                                              b
                                                                              voters_without_quorum
                                                                              __LOC__)
                                                                            (fun
                                                                              voter_rolls
                                                                              =>
                                                                              op_gtgteqquestion
                                                                                (map_s
                                                                                  (fun
                                                                                    del
                                                                                    =>
                                                                                    op_startypeminuserrorstar
                                                                                      op_startypeminuserrorstar
                                                                                      del
                                                                                      Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.zero)
                                                                                      Tezos_protocol_alpha.Protocol.Alpha_context.Vote.Yay)
                                                                                  voters_without_quorum)
                                                                                (fun
                                                                                  operations
                                                                                  =>
                                                                                  op_gtgteqquestion
                                                                                    (op_startypeminuserrorstar
                                                                                      operations
                                                                                      b)
                                                                                    (fun
                                                                                      b
                                                                                      =>
                                                                                      op_gtgteqquestion
                                                                                        (op_startypeminuserrorstar
                                                                                          (op_minus
                                                                                            (Int32.to_int
                                                                                              op_startypeminuserrorstar)
                                                                                            1)
                                                                                          b)
                                                                                        (fun
                                                                                          b
                                                                                          =>
                                                                                          op_gtgteqquestion
                                                                                            (get_expected_participation_ema
                                                                                              rolls_p4
                                                                                              voter_rolls
                                                                                              initial_participation_ema)
                                                                                            (fun
                                                                                              expected_participation_ema
                                                                                              =>
                                                                                              op_gtgteqquestion
                                                                                                (op_startypeminuserrorstar
                                                                                                  b)
                                                                                                (fun
                                                                                                  new_participation_ema
                                                                                                  =>
                                                                                                  op_gtgteqquestion
                                                                                                    (op_startypeminuserrorstar
                                                                                                      __LOC__
                                                                                                      expected_participation_ema
                                                                                                      (Int32.to_int
                                                                                                        new_participation_ema))
                                                                                                    (fun
                                                                                                      function_parameter
                                                                                                      =>
                                                                                                      let
                                                                                                        'tt :=
                                                                                                        function_parameter
                                                                                                        in
                                                                                                      op_gtgteqquestion
                                                                                                        (op_gtgteqquestion
                                                                                                          (op_startypeminuserrorstar
                                                                                                            op_startypeminuserrorstar)
                                                                                                          (fun
                                                                                                            function_parameter
                                                                                                            =>
                                                                                                            match
                                                                                                              function_parameter
                                                                                                              with
                                                                                                            |
                                                                                                              _
                                                                                                              =>
                                                                                                              return_unit
                                                                                                            |
                                                                                                              _
                                                                                                              =>
                                                                                                              failwith
                                                                                                                "%s - Unexpected period kind"
                                                                                                                  %
                                                                                                                  string
                                                                                                                __LOC__
                                                                                                            end))
                                                                                                        (fun
                                                                                                          function_parameter
                                                                                                          =>
                                                                                                          let
                                                                                                            'tt :=
                                                                                                            function_parameter
                                                                                                            in
                                                                                                          return_unit)))))))))))))))))))))))))).

Definition test_multiple_identical_proposals_count_as_one
  (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  op_gtgteqquestion (op_startypeminuserrorstar 1)
    (fun function_parameter =>
      let '(b, delegates) := function_parameter in
      op_gtgteqquestion
        (op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
          (fun function_parameter =>
            match function_parameter with
            | _ => return_unit
            | _ => failwith "%s - Unexpected period kind" % string __LOC__
            end))
        (fun function_parameter =>
          let 'tt := function_parameter in
          let proposer := List.hd delegates in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar proposer
              (cons
                Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.zero)
                (cons
                  Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.zero)
                  [])))
            (fun ops =>
              op_gtgteqquestion (op_startypeminuserrorstar (cons ops []) b)
                (fun b =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar)
                    (fun ps =>
                      op_gtgteqquestion (op_startypeminuserrorstar proposer)
                        (fun pkh =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar op_startypeminuserrorstar)
                            (fun l =>
                              op_gtgteqquestion
                                match
                                  List.find_opt
                                    (fun function_parameter =>
                                      let '(del, _) := function_parameter in
                                      op_startypeminuserrorstar del pkh) l with
                                | None =>
                                  failwith "%s - Missing delegate" % string
                                    __LOC__
                                | Some (_, proposer_rolls) =>
                                  __return proposer_rolls
                                end
                                (fun proposer_rolls =>
                                  let expected_weight_proposer := proposer_rolls
                                    in
                                  match Map.find_opt zero ps with
                                  | Some v =>
                                    if
                                      op_startypeminuserrorstar v
                                        expected_weight_proposer then
                                      return_unit
                                    else
                                      failwith
                                        "%s - Wrong count %ld is not %ld; identical proposals count as one"
                                          % string __LOC__ v
                                        expected_weight_proposer
                                  | None =>
                                    failwith "%s - Missing proposal" % string
                                      __LOC__
                                  end)))))))).

Definition test_supermajority_in_proposal {A : Type}
  (there_is_a_winner : bool) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult A) :=
  let 'tt := function_parameter in
  let min_proposal_quorum :=
    (* ❌ Constant of type int32 is converted to int *)
    0 in
  op_gtgteqquestion
    (op_startypeminuserrorstar min_proposal_quorum
      (cons
        (* ❌ Constant of type int64 is converted to int *)
        1
        (cons
          (* ❌ Constant of type int64 is converted to int *)
          1
          (cons
            (* ❌ Constant of type int64 is converted to int *)
            1 []))) 10)
    (fun function_parameter =>
      let '(b, delegates) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
        (fun function_parameter =>
          let '_ := function_parameter in
          let del1 := op_startypeminuserrorstar delegates 0 in
          let del2 := op_startypeminuserrorstar delegates 1 in
          let del3 := op_startypeminuserrorstar delegates 2 in
          op_gtgteqquestion
            (map_s (fun del => op_startypeminuserrorstar del)
              (cons del1 (cons del2 (cons del3 []))))
            (fun pkhs =>
              let policy := op_startypeminuserrorstar in
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar
                  (op_startypeminuserrorstar delegates 3) del1
                  op_startypeminuserrorstar)
                (fun op1 =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      (op_startypeminuserrorstar delegates 4) del2
                      op_startypeminuserrorstar)
                    (fun op2 =>
                      op_startypeminuserrorstar
                        (if there_is_a_winner then
                          op_startypeminuserrorstar op_startypeminuserrorstar
                            (* ❌ Constant of type int64 is converted to int *)
                            3
                        else
                          op_startypeminuserrorstar op_startypeminuserrorstar
                            (* ❌ Constant of type int64 is converted to int *)
                            2)
                        (fun bal3 =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar op_startypeminuserrorstar
                              (op_startypeminuserrorstar delegates 5) del3 bal3)
                            (fun op3 =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar policy
                                  (cons op1 (cons op2 (cons op3 []))) b)
                                (fun b =>
                                  op_gtgteqquestion
                                    (fold_left_s
                                      (fun b =>
                                        fun function_parameter =>
                                          let '_ := function_parameter in
                                          op_gtgteqquestion
                                            (Error_monad.map_s
                                              (fun del =>
                                                op_gtgteqquestion
                                                  (op_startypeminuserrorstar del)
                                                  (fun pkh =>
                                                    op_startypeminuserrorstar
                                                      op_startypeminuserrorstar
                                                      del (Some pkh))) delegates)
                                            (fun ops =>
                                              op_gtgteqquestion
                                                (op_startypeminuserrorstar
                                                  policy ops b)
                                                (fun b =>
                                                  op_startypeminuserrorstar
                                                    policy b))) b
                                      (op_startypeminuserrorstar 1
                                        (Int32.to_int
                                          (Int32.div op_startypeminuserrorstar
                                            op_startypeminuserrorstar))))
                                    (fun b =>
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar
                                          op_startypeminuserrorstar del1
                                          (cons
                                            (op_startypeminuserrorstar protos 0)
                                            []))
                                        (fun ops1 =>
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar
                                              op_startypeminuserrorstar del2
                                              (cons
                                                (op_startypeminuserrorstar
                                                  protos 0) []))
                                            (fun ops2 =>
                                              op_gtgteqquestion
                                                (op_startypeminuserrorstar
                                                  op_startypeminuserrorstar del3
                                                  (cons
                                                    (op_startypeminuserrorstar
                                                      protos 1) []))
                                                (fun ops3 =>
                                                  op_gtgteqquestion
                                                    (op_startypeminuserrorstar
                                                      policy
                                                      (cons ops1
                                                        (cons ops2
                                                          (cons ops3 []))) b)
                                                    (fun b =>
                                                      op_gtgteqquestion
                                                        (op_startypeminuserrorstar
                                                          policy
                                                          (op_minus
                                                            (Int32.to_int
                                                              op_startypeminuserrorstar)
                                                            1) b)
                                                        (fun b =>
                                                          op_gtgteqquestion
                                                            (op_gtgteqquestion
                                                              (op_startypeminuserrorstar
                                                                op_startypeminuserrorstar)
                                                              (fun
                                                                function_parameter
                                                                =>
                                                                match
                                                                  function_parameter
                                                                  with
                                                                | _ =>
                                                                  if
                                                                    there_is_a_winner
                                                                    then
                                                                    return_unit
                                                                  else
                                                                    failwith
                                                                      "%s - Expected period kind Proposal, obtained Testing_vote"
                                                                        % string
                                                                      __LOC__
                                                                | _ =>
                                                                  if
                                                                    not
                                                                      there_is_a_winner
                                                                    then
                                                                    return_unit
                                                                  else
                                                                    failwith
                                                                      "%s - Expected period kind Testing_vote, obtained Proposal"
                                                                        % string
                                                                      __LOC__
                                                                | _ =>
                                                                  failwith
                                                                    "%s - Unexpected period kind"
                                                                      % string
                                                                    __LOC__
                                                                end))
                                                            (fun
                                                              function_parameter
                                                              =>
                                                              let 'tt :=
                                                                function_parameter
                                                                in
                                                              return_unit))))))))))))))).

Definition test_quorum_in_proposal
  (has_quorum : bool) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  let total_tokens :=
    (* ❌ Constant of type int64 is converted to int *)
    32000000000000 in
  let half_tokens :=
    Int64.div total_tokens
      (* ❌ Constant of type int64 is converted to int *)
      2 in
  op_gtgteqquestion
    (op_startypeminuserrorstar
      (cons
        (* ❌ Constant of type int64 is converted to int *)
        1 (cons half_tokens (cons half_tokens []))) 3)
    (fun function_parameter =>
      let '(b, delegates) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
        (fun function_parameter =>
          let '_ := function_parameter in
          let del1 := op_startypeminuserrorstar delegates 0 in
          let del2 := op_startypeminuserrorstar delegates 1 in
          op_gtgteqquestion
            (map_s (fun del => op_startypeminuserrorstar del)
              (cons del1 (cons del2 [])))
            (fun pkhs =>
              let policy := op_startypeminuserrorstar in
              let quorum :=
                if has_quorum then
                  Int64.of_int32 op_startypeminuserrorstar
                else
                  sub (of_int32 op_startypeminuserrorstar)
                    (* ❌ Constant of type int64 is converted to int *)
                    10 in
              let bal :=
                op_pipegt
                  (div (mul total_tokens quorum)
                    (* ❌ Constant of type int64 is converted to int *)
                    10000) op_startypeminuserrorstar in
              op_gtgteqquestion
                (op_startypeminuserrorstar op_startypeminuserrorstar del2 del1
                  bal)
                (fun op2 =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar policy (cons op2 []) b)
                    (fun b =>
                      op_gtgteqquestion
                        (fold_left_s
                          (fun b =>
                            fun function_parameter =>
                              let '_ := function_parameter in
                              op_gtgteqquestion
                                (Error_monad.map_s
                                  (fun del =>
                                    op_gtgteqquestion
                                      (op_startypeminuserrorstar del)
                                      (fun pkh =>
                                        op_startypeminuserrorstar
                                          op_startypeminuserrorstar del
                                          (Some pkh)))
                                  (cons del1 (cons del2 [])))
                                (fun ops =>
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar policy ops b)
                                    (fun b => op_startypeminuserrorstar policy b)))
                          b
                          (op_startypeminuserrorstar 1
                            (Int32.to_int
                              (Int32.div op_startypeminuserrorstar
                                op_startypeminuserrorstar))))
                        (fun b =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar op_startypeminuserrorstar
                              del1
                              (cons (op_startypeminuserrorstar protos 0) []))
                            (fun ops =>
                              op_gtgteqquestion
                                (op_startypeminuserrorstar policy (cons ops [])
                                  b)
                                (fun b =>
                                  op_gtgteqquestion
                                    (op_startypeminuserrorstar policy
                                      (op_minus
                                        (Int32.to_int op_startypeminuserrorstar)
                                        1) b)
                                    (fun b =>
                                      op_gtgteqquestion
                                        (op_gtgteqquestion
                                          (op_startypeminuserrorstar
                                            op_startypeminuserrorstar)
                                          (fun function_parameter =>
                                            match function_parameter with
                                            | _ =>
                                              if has_quorum then
                                                return_unit
                                              else
                                                failwith
                                                  "%s - Expected period kind Proposal, obtained Testing_vote"
                                                    % string __LOC__
                                            | _ =>
                                              if not has_quorum then
                                                return_unit
                                              else
                                                failwith
                                                  "%s - Expected period kind Testing_vote, obtained Proposal"
                                                    % string __LOC__
                                            | _ =>
                                              failwith
                                                "%s - Unexpected period kind" %
                                                  string __LOC__
                                            end))
                                        (fun function_parameter =>
                                          let 'tt := function_parameter in
                                          return_unit)))))))))).

Definition test_supermajority_in_testing_vote
  (supermajority : bool) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  let min_proposal_quorum := op_atat of_int (op_div 10000 100) in
  op_gtgteqquestion (op_startypeminuserrorstar min_proposal_quorum 100)
    (fun function_parameter =>
      let '(b, delegates) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
        (fun function_parameter =>
          let '_ := function_parameter in
          let del1 := op_startypeminuserrorstar delegates 0 in
          let proposal := op_startypeminuserrorstar protos 0 in
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar del1
              (cons proposal []))
            (fun ops1 =>
              op_gtgteqquestion (op_startypeminuserrorstar (cons ops1 []) b)
                (fun b =>
                  op_gtgteqquestion
                    (op_startypeminuserrorstar
                      (op_minus (Int32.to_int op_startypeminuserrorstar) 1) b)
                    (fun b =>
                      op_gtgteqquestion
                        (op_gtgteqquestion
                          (op_startypeminuserrorstar op_startypeminuserrorstar)
                          (fun function_parameter =>
                            match function_parameter with
                            | _ => return_unit
                            | _ =>
                              failwith "%s - Unexpected period kind" % string
                                __LOC__
                            end))
                        (fun function_parameter =>
                          let 'tt := function_parameter in
                          op_gtgteqquestion
                            (op_gtgteqquestion
                              (op_startypeminuserrorstar
                                op_startypeminuserrorstar)
                              (fun function_parameter =>
                                match function_parameter with
                                | Some v =>
                                  if
                                    Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.equal)
                                      proposal v then
                                    return_unit
                                  else
                                    failwith "%s - Wrong proposal" % string
                                      __LOC__
                                | None =>
                                  failwith "%s - Missing proposal" % string
                                    __LOC__
                                end))
                            (fun function_parameter =>
                              let 'tt := function_parameter in
                              op_gtgteqquestion
                                (get_delegates_and_rolls_from_listings b)
                                (fun function_parameter =>
                                  let '(delegates_p2, _olls_p2) :=
                                    function_parameter in
                                  let num_delegates := List.length delegates_p2
                                    in
                                  let num_nays := op_div num_delegates 5 in
                                  let num_yays :=
                                    op_div (op_star num_nays s_num)
                                      (op_minus s_den s_num) in
                                  let num_yays :=
                                    if supermajority then
                                      num_yays
                                    else
                                      op_minus num_yays 1 in
                                  let '(nays_delegates, rest) :=
                                    op_startypeminuserrorstar num_nays
                                      delegates_p2 in
                                  let '(yays_delegates, _) :=
                                    op_startypeminuserrorstar num_yays rest in
                                  op_gtgteqquestion
                                    (map_s
                                      (fun del =>
                                        op_startypeminuserrorstar
                                          op_startypeminuserrorstar del proposal
                                          Tezos_protocol_alpha.Protocol.Alpha_context.Vote.Yay)
                                      yays_delegates)
                                    (fun operations_yays =>
                                      op_gtgteqquestion
                                        (map_s
                                          (fun del =>
                                            op_startypeminuserrorstar
                                              op_startypeminuserrorstar del
                                              proposal
                                              Tezos_protocol_alpha.Protocol.Alpha_context.Vote.Nay)
                                          nays_delegates)
                                        (fun operations_nays =>
                                          let operations :=
                                            op_at operations_yays
                                              operations_nays in
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar
                                              operations b)
                                            (fun b =>
                                              op_gtgteqquestion
                                                (op_startypeminuserrorstar
                                                  (op_minus
                                                    (Int32.to_int
                                                      op_startypeminuserrorstar)
                                                    1) b)
                                                (fun b =>
                                                  op_gtgteqquestion
                                                    (op_gtgteqquestion
                                                      (op_startypeminuserrorstar
                                                        op_startypeminuserrorstar)
                                                      (fun function_parameter =>
                                                        match function_parameter
                                                          with
                                                        | _ =>
                                                          if supermajority then
                                                            return_unit
                                                          else
                                                            failwith
                                                              "%s - Expected period kind Proposal, obtained Testing"
                                                                % string __LOC__
                                                        | _ =>
                                                          if not supermajority
                                                            then
                                                            return_unit
                                                          else
                                                            failwith
                                                              "%s - Expected period kind Testing_vote, obtained Proposal"
                                                                % string __LOC__
                                                        | _ =>
                                                          failwith
                                                            "%s - Unexpected period kind"
                                                              % string __LOC__
                                                        end))
                                                    (fun function_parameter =>
                                                      let 'tt :=
                                                        function_parameter in
                                                      return_unit))))))))))))).

Definition test_no_winning_proposal
  (num_delegates : Z) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  let min_proposal_quorum := op_atat of_int (op_div 10000 num_delegates) in
  op_gtgteqquestion
    (op_startypeminuserrorstar min_proposal_quorum num_delegates)
    (fun function_parameter =>
      let '(b, _) := function_parameter in
      op_gtgteqquestion (op_startypeminuserrorstar op_startypeminuserrorstar)
        (fun function_parameter =>
          let '_ := function_parameter in
          op_gtgteqquestion (get_delegates_and_rolls_from_listings b)
            (fun function_parameter =>
              let '(delegates_p1, _rolls_p1) := function_parameter in
              let props :=
                List.map (fun i => op_startypeminuserrorstar protos i)
                  (op_startypeminuserrorstar 1
                    Constants.max_proposals_per_delegate) in
              op_gtgteqquestion
                (map_s
                  (fun del =>
                    op_startypeminuserrorstar op_startypeminuserrorstar del
                      props) delegates_p1)
                (fun ops_list =>
                  op_gtgteqquestion (op_startypeminuserrorstar ops_list b)
                    (fun b =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar
                          (op_minus (Int32.to_int op_startypeminuserrorstar) 2)
                          b)
                        (fun b =>
                          op_gtgteqquestion
                            (op_gtgteqquestion
                              (op_startypeminuserrorstar
                                op_startypeminuserrorstar)
                              (fun function_parameter =>
                                match function_parameter with
                                | _ => return_unit
                                | _ =>
                                  failwith
                                    "%s - Unexpected period kind" % string
                                    __LOC__
                                end))
                            (fun function_parameter =>
                              let 'tt := function_parameter in
                              return_unit))))))).

Definition test_quorum_capped_maximum
  (num_delegates : Z) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  let min_proposal_quorum := op_atat of_int (op_div 10000 num_delegates) in
  op_gtgteqquestion
    (op_startypeminuserrorstar min_proposal_quorum num_delegates)
    (fun function_parameter =>
      let '(b, delegates) := function_parameter in
      op_gtgteq
        (op_startypeminuserrorstar b
          (* ❌ Constant of type int32 is converted to int *)
          10000)
        (fun b =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar)
            (fun function_parameter =>
              let '_ := function_parameter in
              op_gtgteqquestion
                (op_gtgteqquestion
                  (op_startypeminuserrorstar op_startypeminuserrorstar)
                  (fun function_parameter =>
                    match function_parameter with
                    | _ => return_unit
                    | _ =>
                      failwith "%s - Unexpected period kind" % string __LOC__
                    end))
                (fun function_parameter =>
                  let 'tt := function_parameter in
                  let protocol :=
                    Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.zero)
                    in
                  let proposer := op_startypeminuserrorstar delegates 0 in
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      proposer (cons protocol []))
                    (fun ops =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar (cons ops []) b)
                        (fun b =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar
                              (op_minus (Int32.to_int op_startypeminuserrorstar)
                                1) b)
                            (fun b =>
                              op_gtgteqquestion
                                (op_gtgteqquestion
                                  (op_startypeminuserrorstar
                                    op_startypeminuserrorstar)
                                  (fun function_parameter =>
                                    match function_parameter with
                                    | _ => return_unit
                                    | _ =>
                                      failwith
                                        "%s - Unexpected period kind" % string
                                        __LOC__
                                    end))
                                (fun function_parameter =>
                                  let 'tt := function_parameter in
                                  let minimum_to_pass :=
                                    op_pipegt
                                      (op_pipegt
                                        (op_startypeminuserrorstar
                                          (op_startypeminuserrorstar
                                            (op_startypeminuserrorstar
                                              (List.length delegates))
                                            (to_float op_startypeminuserrorstar))
                                          (* ❌ Float constant 100_00. is approximated by the integer 10000 *)
                                          10000) op_startypeminuserrorstar)
                                      op_startypeminuserrorstar in
                                  let voters :=
                                    op_startypeminuserrorstar minimum_to_pass
                                      delegates in
                                  op_gtgteqquestion
                                    (map_s
                                      (fun del =>
                                        op_startypeminuserrorstar
                                          op_startypeminuserrorstar del protocol
                                          Tezos_protocol_alpha.Protocol.Alpha_context.Vote.Yay)
                                      voters)
                                    (fun operations =>
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar operations b)
                                        (fun b =>
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar
                                              (op_minus
                                                (Int32.to_int
                                                  op_startypeminuserrorstar) 1)
                                              b)
                                            (fun b =>
                                              op_gtgteqquestion
                                                (op_startypeminuserrorstar
                                                  op_startypeminuserrorstar)
                                                (fun function_parameter =>
                                                  match function_parameter with
                                                  | _ => return_unit
                                                  | _ =>
                                                    failwith
                                                      "%s - Unexpected period kind"
                                                        % string __LOC__
                                                  end)))))))))))).

Definition test_quorum_capped_minimum
  (num_delegates : Z) (function_parameter : unit)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult unit) :=
  let 'tt := function_parameter in
  let min_proposal_quorum := op_atat of_int (op_div 10000 num_delegates) in
  op_gtgteqquestion
    (op_startypeminuserrorstar min_proposal_quorum num_delegates)
    (fun function_parameter =>
      let '(b, delegates) := function_parameter in
      op_gtgteq
        (op_startypeminuserrorstar b
          (* ❌ Constant of type int32 is converted to int *)
          0)
        (fun b =>
          op_gtgteqquestion
            (op_startypeminuserrorstar op_startypeminuserrorstar)
            (fun function_parameter =>
              let '_ := function_parameter in
              op_gtgteqquestion
                (op_gtgteqquestion
                  (op_startypeminuserrorstar op_startypeminuserrorstar)
                  (fun function_parameter =>
                    match function_parameter with
                    | _ => return_unit
                    | _ =>
                      failwith "%s - Unexpected period kind" % string __LOC__
                    end))
                (fun function_parameter =>
                  let 'tt := function_parameter in
                  let protocol :=
                    Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.zero)
                    in
                  let proposer := op_startypeminuserrorstar delegates 0 in
                  op_gtgteqquestion
                    (op_startypeminuserrorstar op_startypeminuserrorstar
                      proposer (cons protocol []))
                    (fun ops =>
                      op_gtgteqquestion
                        (op_startypeminuserrorstar (cons ops []) b)
                        (fun b =>
                          op_gtgteqquestion
                            (op_startypeminuserrorstar
                              (op_minus (Int32.to_int op_startypeminuserrorstar)
                                1) b)
                            (fun b =>
                              op_gtgteqquestion
                                (op_gtgteqquestion
                                  (op_startypeminuserrorstar
                                    op_startypeminuserrorstar)
                                  (fun function_parameter =>
                                    match function_parameter with
                                    | _ => return_unit
                                    | _ =>
                                      failwith
                                        "%s - Unexpected period kind" % string
                                        __LOC__
                                    end))
                                (fun function_parameter =>
                                  let 'tt := function_parameter in
                                  let minimum_to_pass :=
                                    op_pipegt
                                      (op_pipegt
                                        (op_startypeminuserrorstar
                                          (op_startypeminuserrorstar
                                            (op_startypeminuserrorstar
                                              (List.length delegates))
                                            (to_float op_startypeminuserrorstar))
                                          (* ❌ Float constant 100_00. is approximated by the integer 10000 *)
                                          10000) op_startypeminuserrorstar)
                                      op_startypeminuserrorstar in
                                  let voters :=
                                    op_startypeminuserrorstar minimum_to_pass
                                      delegates in
                                  op_gtgteqquestion
                                    (map_s
                                      (fun del =>
                                        op_startypeminuserrorstar
                                          op_startypeminuserrorstar del protocol
                                          Tezos_protocol_alpha.Protocol.Alpha_context.Vote.Yay)
                                      voters)
                                    (fun operations =>
                                      op_gtgteqquestion
                                        (op_startypeminuserrorstar operations b)
                                        (fun b =>
                                          op_gtgteqquestion
                                            (op_startypeminuserrorstar
                                              (op_minus
                                                (Int32.to_int
                                                  op_startypeminuserrorstar) 1)
                                              b)
                                            (fun b =>
                                              op_gtgteqquestion
                                                (op_startypeminuserrorstar
                                                  op_startypeminuserrorstar)
                                                (fun function_parameter =>
                                                  match function_parameter with
                                                  | _ => return_unit
                                                  | _ =>
                                                    failwith
                                                      "%s - Unexpected period kind"
                                                        % string __LOC__
                                                  end)))))))))))).

Definition tests {A : Type} : list A :=
  cons
    (op_startypeminuserrorstar "voting successful_vote" % string
      (* ❌ Variants not supported *)
      variant (test_successful_vote 137))
    (cons
      (op_startypeminuserrorstar
        "voting testing vote, not enough quorum" % string
        (* ❌ Variants not supported *)
        variant (test_not_enough_quorum_in_testing_vote 245))
      (cons
        (op_startypeminuserrorstar
          "voting promotion vote, not enough quorum" % string
          (* ❌ Variants not supported *)
          variant (test_not_enough_quorum_in_promotion_vote 432))
        (cons
          (op_startypeminuserrorstar "voting counting double proposal" % string
            (* ❌ Variants not supported *)
            variant test_multiple_identical_proposals_count_as_one)
          (cons
            (op_startypeminuserrorstar
              "voting proposal, with supermajority" % string
              (* ❌ Variants not supported *)
              variant (test_supermajority_in_proposal true))
            (cons
              (op_startypeminuserrorstar
                "voting proposal, without supermajority" % string
                (* ❌ Variants not supported *)
                variant (test_supermajority_in_proposal false))
              (cons
                (op_startypeminuserrorstar
                  "voting proposal, with quorum" % string
                  (* ❌ Variants not supported *)
                  variant (test_quorum_in_proposal true))
                (cons
                  (op_startypeminuserrorstar
                    "voting proposal, without quorum" % string
                    (* ❌ Variants not supported *)
                    variant (test_quorum_in_proposal false))
                  (cons
                    (op_startypeminuserrorstar
                      "voting testing vote, with supermajority" % string
                      (* ❌ Variants not supported *)
                      variant (test_supermajority_in_testing_vote true))
                    (cons
                      (op_startypeminuserrorstar
                        "voting testing vote, without supermajority" % string
                        (* ❌ Variants not supported *)
                        variant (test_supermajority_in_testing_vote false))
                      (cons
                        (op_startypeminuserrorstar
                          "voting proposal, no winning proposal" % string
                          (* ❌ Variants not supported *)
                          variant (test_no_winning_proposal 400))
                        (cons
                          (op_startypeminuserrorstar
                            "voting quorum, quorum capped maximum" % string
                            (* ❌ Variants not supported *)
                            variant (test_quorum_capped_maximum 400))
                          (cons
                            (op_startypeminuserrorstar
                              "voting quorum, quorum capped minimum" % string
                              (* ❌ Variants not supported *)
                              variant (test_quorum_capped_minimum 401)) [])))))))))))).
tez_repr.ml 2 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

include Qty_repr.Make (struct
  let id = "tez"
end)

type t = qty

type tez = qty

let encoding = Data_encoding.def "mutez" @@ encoding
tez_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

(* ❌ Cannot include this kind of module expression *)
include

Definition t := qty.

Definition tez := qty.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding qty :=
  op_atat
    (let arg := Data_encoding.def "mutez" % string in
    fun eta => arg None None eta) encoding.
tez_repr.mli 2 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t

type tez = t

include Qty_repr.S with type qty := t
tez_repr_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter t : Type.

Definition tez := t.

include
time_repr.ml 9 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

include Time

type time = t

type error += Timestamp_add (* `Permanent *)

type error += Timestamp_sub (* `Permanent *)

let () =
  register_error_kind
    `Permanent
    ~id:"timestamp_add"
    ~title:"Timestamp add"
    ~description:"Overflow when adding timestamps."
    ~pp:(fun ppf () -> Format.fprintf ppf "Overflow when adding timestamps.")
    Data_encoding.empty
    (function Timestamp_add -> Some () | _ -> None)
    (fun () -> Timestamp_add) ;
  register_error_kind
    `Permanent
    ~id:"timestamp_sub"
    ~title:"Timestamp sub"
    ~description:"Substracting timestamps resulted in negative period."
    ~pp:(fun ppf () ->
      Format.fprintf ppf "Substracting timestamps resulted in negative period.")
    Data_encoding.empty
    (function Timestamp_sub -> Some () | _ -> None)
    (fun () -> Timestamp_sub)

let of_seconds s = try Some (of_seconds (Int64.of_string s)) with _ -> None

let to_seconds = to_seconds

let to_seconds_string s = Int64.to_string (to_seconds s)

let pp = pp_hum

let ( +? ) x y =
  try ok (add x (Period_repr.to_seconds y)) with _exn -> error Timestamp_add

let ( -? ) x y = record_trace Timestamp_sub (Period_repr.of_seconds (diff x y))
time_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Export Time.

Definition time := t.

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Structure item `typext` not handled. *)
type_extension

(* ❌ Top-level evaluations are considered as an error as sources of side-effects *)
Compute
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register_error_kind
      (* ❌ Variants not supported *)
      variant "timestamp_add" % string "Timestamp add" % string
      "Overflow when adding timestamps." % string
      (Some
        (fun ppf =>
          fun function_parameter =>
            let 'tt := function_parameter in
            Format.fprintf ppf
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
                (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                  "Overflow when adding timestamps." % string
                  Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
                "Overflow when adding timestamps." % string)))
      Data_encoding.empty
      (fun function_parameter =>
        match function_parameter with
        |
          Tezos_protocol_environment_alpha__Environment.Error_monad.Timestamp_add
          => Some tt
        | _ => None
        end)
      (fun function_parameter =>
        let 'tt := function_parameter in
        Tezos_protocol_environment_alpha__Environment.Error_monad.Timestamp_add)
    in
  register_error_kind
    (* ❌ Variants not supported *)
    variant "timestamp_sub" % string "Timestamp sub" % string
    "Substracting timestamps resulted in negative period." % string
    (Some
      (fun ppf =>
        fun function_parameter =>
          let 'tt := function_parameter in
          Format.fprintf ppf
            (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
              (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.String_literal
                "Substracting timestamps resulted in negative period." % string
                Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
              "Substracting timestamps resulted in negative period." % string)))
    Data_encoding.empty
    (fun function_parameter =>
      match function_parameter with
      | Tezos_protocol_environment_alpha__Environment.Error_monad.Timestamp_sub
        => Some tt
      | _ => None
      end)
    (fun function_parameter =>
      let 'tt := function_parameter in
      Tezos_protocol_environment_alpha__Environment.Error_monad.Timestamp_sub).

Definition of_seconds (s : string) : option t :=
  (* ❌ Try-with are not handled *)
  try (Some (of_seconds (Int64.of_string s))).

Definition to_seconds : t -> int64 := to_seconds.

Definition to_seconds_string (s : t) : string := Int64.to_string (to_seconds s).

Definition pp
  : Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit :=
  pp_hum.

Definition op_plusquestion
  (x : t) (y : Tezos_raw_protocol_alpha.Period_repr.period)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult t :=
  (* ❌ Try-with are not handled *)
  try (ok (add x (Period_repr.to_seconds y))).

Definition op_minusquestion (x : t) (y : t)
  : Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
    Tezos_raw_protocol_alpha.Period_repr.period :=
  record_trace
    Tezos_protocol_environment_alpha__Environment.Error_monad.Timestamp_sub
    (Period_repr.of_seconds (diff x y)).
time_repr.mli 2 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

include module type of struct
  include Time
end

type time = t

val pp : Format.formatter -> t -> unit

val of_seconds : string -> time option

val to_seconds_string : time -> string

val ( +? ) : time -> Period_repr.t -> time tzresult

val ( -? ) : time -> time -> Period_repr.t tzresult
time_repr_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

include

Definition time := t.

Parameter pp :
Tezos_protocol_environment_alpha__Environment.Format.formatter -> t -> unit.

Parameter of_seconds : string -> option time.

Parameter to_seconds_string : time -> string.

Parameter op_plusquestion :
time ->
  Tezos_raw_protocol_alpha.Period_repr.t ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult time.

Parameter op_minusquestion :
time ->
  time ->
    Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Period_repr.t.
vote_repr.ml 2 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type proposal = Protocol_hash.t

type ballot = Yay | Nay | Pass

let ballot_encoding =
  let of_int8 = function
    | 0 ->
        Yay
    | 1 ->
        Nay
    | 2 ->
        Pass
    | _ ->
        invalid_arg "ballot_of_int8"
  in
  let to_int8 = function Yay -> 0 | Nay -> 1 | Pass -> 2 in
  let open Data_encoding in
  (* union *)
  splitted
    ~binary:(conv to_int8 of_int8 int8)
    ~json:(string_enum [("yay", Yay); ("nay", Nay); ("pass", Pass)])
vote_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition proposal :=
  Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t).

Inductive ballot : Type :=
| Yay : ballot
| Nay : ballot
| Pass : ballot.

Definition ballot_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding ballot :=
  let of_int8 (function_parameter : Z) : ballot :=
    match function_parameter with
    | 0 => Yay
    | 1 => Nay
    | 2 => Pass
    | _ => invalid_arg "ballot_of_int8" % string
    end in
  let to_int8 (function_parameter : ballot) : Z :=
    match function_parameter with
    | Yay => 0
    | Nay => 1
    | Pass => 2
    end in
  splitted
    (string_enum
      (cons ("yay" % string, Yay)
        (cons ("nay" % string, Nay) (cons ("pass" % string, Pass) []))))
    (conv to_int8 of_int8 None int8).
vote_repr.mli 2 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** a protocol change proposal *)
type proposal = Protocol_hash.t

(** votes can be for, against or neutral.
    Neutral serves to count towards a quorum *)
type ballot = Yay | Nay | Pass

val ballot_encoding : ballot Data_encoding.t
vote_repr_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition proposal :=
  Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t).

Inductive ballot : Type :=
| Yay : ballot
| Nay : ballot
| Pass : ballot.

Parameter ballot_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t ballot.
vote_storage.ml 9 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

let recorded_proposal_count_for_delegate ctxt proposer =
  Storage.Vote.Proposals_count.get_option ctxt proposer
  >>=? function None -> return 0 | Some count -> return count

let record_proposal ctxt proposal proposer =
  recorded_proposal_count_for_delegate ctxt proposer
  >>=? fun count ->
  Storage.Vote.Proposals_count.init_set ctxt proposer (count + 1)
  >>= fun ctxt ->
  Storage.Vote.Proposals.add ctxt (proposal, proposer)
  >>= fun ctxt -> return ctxt

let get_proposals ctxt =
  Storage.Vote.Proposals.fold
    ctxt
    ~init:(ok Protocol_hash.Map.empty)
    ~f:(fun (proposal, delegate) acc ->
      (* Assuming the same listings is used at votings *)
      Storage.Vote.Listings.get ctxt delegate
      >>=? fun weight ->
      Lwt.return
        ( acc
        >>? fun acc ->
        let previous =
          match Protocol_hash.Map.find_opt proposal acc with
          | None ->
              0l
          | Some x ->
              x
        in
        ok (Protocol_hash.Map.add proposal (Int32.add weight previous) acc) ))

let clear_proposals ctxt =
  Storage.Vote.Proposals_count.clear ctxt
  >>= fun ctxt -> Storage.Vote.Proposals.clear ctxt

type ballots = {yay : int32; nay : int32; pass : int32}

let ballots_encoding =
  let open Data_encoding in
  conv
    (fun {yay; nay; pass} -> (yay, nay, pass))
    (fun (yay, nay, pass) -> {yay; nay; pass})
  @@ obj3 (req "yay" int32) (req "nay" int32) (req "pass" int32)

let has_recorded_ballot = Storage.Vote.Ballots.mem

let record_ballot = Storage.Vote.Ballots.init

let get_ballots ctxt =
  Storage.Vote.Ballots.fold
    ctxt
    ~f:(fun delegate ballot (ballots : ballots tzresult) ->
      (* Assuming the same listings is used at votings *)
      Storage.Vote.Listings.get ctxt delegate
      >>=? fun weight ->
      let count = Int32.add weight in
      Lwt.return
        ( ballots
        >>? fun ballots ->
        match ballot with
        | Yay ->
            ok {ballots with yay = count ballots.yay}
        | Nay ->
            ok {ballots with nay = count ballots.nay}
        | Pass ->
            ok {ballots with pass = count ballots.pass} ))
    ~init:(ok {yay = 0l; nay = 0l; pass = 0l})

let get_ballot_list = Storage.Vote.Ballots.bindings

let clear_ballots = Storage.Vote.Ballots.clear

let listings_encoding =
  Data_encoding.(
    list
      (obj2 (req "pkh" Signature.Public_key_hash.encoding) (req "rolls" int32)))

let freeze_listings ctxt =
  Roll_storage.fold ctxt (ctxt, 0l) ~f:(fun _roll delegate (ctxt, total) ->
      (* TODO use snapshots *)
      let delegate = Signature.Public_key.hash delegate in
      Storage.Vote.Listings.get_option ctxt delegate
      >>=? (function None -> return 0l | Some count -> return count)
      >>=? fun count ->
      Storage.Vote.Listings.init_set ctxt delegate (Int32.succ count)
      >>= fun ctxt -> return (ctxt, Int32.succ total))
  >>=? fun (ctxt, total) ->
  Storage.Vote.Listings_size.init ctxt total >>=? fun ctxt -> return ctxt

let listing_size = Storage.Vote.Listings_size.get

let in_listings = Storage.Vote.Listings.mem

let get_listings = Storage.Vote.Listings.bindings

let clear_listings ctxt =
  Storage.Vote.Listings.clear ctxt
  >>= fun ctxt ->
  Storage.Vote.Listings_size.remove ctxt >>= fun ctxt -> return ctxt

let get_current_period_kind = Storage.Vote.Current_period_kind.get

let set_current_period_kind = Storage.Vote.Current_period_kind.set

let get_current_quorum ctxt =
  Storage.Vote.Participation_ema.get ctxt
  >>=? fun participation_ema ->
  let quorum_min = Constants_storage.quorum_min ctxt in
  let quorum_max = Constants_storage.quorum_max ctxt in
  let quorum_diff = Int32.sub quorum_max quorum_min in
  return
    Int32.(add quorum_min (div (mul participation_ema quorum_diff) 100_00l))

let get_participation_ema = Storage.Vote.Participation_ema.get

let set_participation_ema = Storage.Vote.Participation_ema.set

let get_current_proposal = Storage.Vote.Current_proposal.get

let init_current_proposal = Storage.Vote.Current_proposal.init

let clear_current_proposal = Storage.Vote.Current_proposal.delete

let init ctxt =
  (* participation EMA is in centile of a percentage *)
  let participation_ema = Constants_storage.quorum_max ctxt in
  Storage.Vote.Participation_ema.init ctxt participation_ema
  >>=? fun ctxt ->
  Storage.Vote.Current_period_kind.init ctxt Proposal
  >>=? fun ctxt -> return ctxt
vote_storage_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition recorded_proposal_count_for_delegate
  (ctxt : Tezos_raw_protocol_alpha.Storage.Vote.Proposals_count.context)
  (proposer : Tezos_raw_protocol_alpha.Storage.Vote.Proposals_count.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Storage.Vote.Proposals_count.value) :=
  op_gtgteqquestion (Storage.Vote.Proposals_count.get_option ctxt proposer)
    (fun function_parameter =>
      match function_parameter with
      | None => __return 0
      | Some count => __return count
      end).

Definition record_proposal
  (ctxt : Tezos_raw_protocol_alpha.Storage.Vote.Proposals_count.context)
  (proposal :
    Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))
  (proposer : Tezos_raw_protocol_alpha.Storage.Vote.Proposals_count.key)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteqquestion (recorded_proposal_count_for_delegate ctxt proposer)
    (fun count =>
      op_gtgteq
        (Storage.Vote.Proposals_count.init_set ctxt proposer (op_plus count 1))
        (fun ctxt =>
          op_gtgteq (Storage.Vote.Proposals.add ctxt (proposal, proposer))
            (fun ctxt => __return ctxt))).

Definition get_proposals
  (ctxt : Tezos_raw_protocol_alpha.Storage.Vote.Proposals.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.Protocol_hash.Map.t int32)) :=
  Storage.Vote.Proposals.fold ctxt (ok Protocol_hash.Map.empty)
    (fun function_parameter =>
      let '(proposal, delegate) := function_parameter in
      fun acc =>
        op_gtgteqquestion (Storage.Vote.Listings.get ctxt delegate)
          (fun weight =>
            Lwt.__return
              (op_gtgtquestion acc
                (fun acc =>
                  let previous :=
                    match Protocol_hash.Map.find_opt proposal acc with
                    | None =>
                      (* ❌ Constant of type int32 is converted to int *)
                      0
                    | Some x => x
                    end in
                  ok
                    (Protocol_hash.Map.add proposal (Int32.add weight previous)
                      acc))))).

Definition clear_proposals
  (ctxt : Tezos_raw_protocol_alpha.Storage.Vote.Proposals_count.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    Tezos_raw_protocol_alpha.Raw_context.t :=
  op_gtgteq (Storage.Vote.Proposals_count.clear ctxt)
    (fun ctxt => Storage.Vote.Proposals.clear ctxt).

Record ballots := {
  yay : int32;
  nay : int32;
  pass : int32 }.

Definition ballots_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding ballots :=
  op_atat
    (let arg :=
      conv
        (fun function_parameter =>
          let '{| yay := yay; nay := nay; pass := pass |} := function_parameter
            in
          (yay, nay, pass))
        (fun function_parameter =>
          let '(yay, nay, pass) := function_parameter in
          {| yay := yay; nay := nay; pass := pass |}) in
    fun eta => arg None eta)
    (obj3 (req None None "yay" % string int32)
      (req None None "nay" % string int32) (req None None "pass" % string int32)).

Definition has_recorded_ballot
  : Tezos_raw_protocol_alpha.Storage.Vote.Ballots.context ->
    Tezos_raw_protocol_alpha.Storage.Vote.Ballots.key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t bool :=
  Storage.Vote.Ballots.mem.

Definition record_ballot
  : Tezos_raw_protocol_alpha.Storage.Vote.Ballots.context ->
    Tezos_raw_protocol_alpha.Storage.Vote.Ballots.key ->
      Tezos_raw_protocol_alpha.Storage.Vote.Ballots.value ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
            Tezos_raw_protocol_alpha.Raw_context.t) := Storage.Vote.Ballots.init.

Definition get_ballots
  (ctxt : Tezos_raw_protocol_alpha.Storage.Vote.Ballots.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult ballots) :=
  Storage.Vote.Ballots.fold ctxt
    (ok
      {|
        yay :=
          (* ❌ Constant of type int32 is converted to int *)
          0;
        nay :=
          (* ❌ Constant of type int32 is converted to int *)
          0;
        pass :=
          (* ❌ Constant of type int32 is converted to int *)
          0 |})
    (fun delegate =>
      fun ballot =>
        fun ballots =>
          op_gtgteqquestion (Storage.Vote.Listings.get ctxt delegate)
            (fun weight =>
              let count := Int32.add weight in
              Lwt.__return
                (op_gtgtquestion ballots
                  (fun ballots =>
                    match ballot with
                    | Tezos_raw_protocol_alpha.Vote_repr.Yay =>
                      ok
                        (* ❌ Record substitution not handled *)
                        record_substitution
                    | Tezos_raw_protocol_alpha.Vote_repr.Nay =>
                      ok
                        (* ❌ Record substitution not handled *)
                        record_substitution
                    | Tezos_raw_protocol_alpha.Vote_repr.Pass =>
                      ok
                        (* ❌ Record substitution not handled *)
                        record_substitution
                    end)))).

Definition get_ballot_list
  : Tezos_raw_protocol_alpha.Storage.Vote.Ballots.context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (list
        (Tezos_raw_protocol_alpha.Storage.Vote.Ballots.key *
          Tezos_raw_protocol_alpha.Storage.Vote.Ballots.value)) :=
  Storage.Vote.Ballots.bindings.

Definition clear_ballots
  : Tezos_raw_protocol_alpha.Storage.Vote.Ballots.context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      Tezos_raw_protocol_alpha.Raw_context.t := Storage.Vote.Ballots.clear.

Definition listings_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding
    (list
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
        * int32)) :=
  list None
    (obj2 (req None None "pkh" % string Signature.Public_key_hash.encoding)
      (req None None "rolls" % string int32)).

Definition freeze_listings (ctxt : Tezos_raw_protocol_alpha.Raw_context.t)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteqquestion
    (Roll_storage.fold ctxt
      (fun _roll =>
        fun delegate =>
          fun function_parameter =>
            let '(ctxt, total) := function_parameter in
            let delegate := Signature.Public_key.hash delegate in
            op_gtgteqquestion
              (op_gtgteqquestion
                (Storage.Vote.Listings.get_option ctxt delegate)
                (fun function_parameter =>
                  match function_parameter with
                  | None =>
                    __return
                      (* ❌ Constant of type int32 is converted to int *)
                      0
                  | Some count => __return count
                  end))
              (fun count =>
                op_gtgteq
                  (Storage.Vote.Listings.init_set ctxt delegate
                    (Int32.succ count))
                  (fun ctxt => __return (ctxt, (Int32.succ total)))))
      (ctxt,
        (* ❌ Constant of type int32 is converted to int *)
        0))
    (fun function_parameter =>
      let '(ctxt, total) := function_parameter in
      op_gtgteqquestion (Storage.Vote.Listings_size.init ctxt total)
        (fun ctxt => __return ctxt)).

Definition listing_size
  : Tezos_raw_protocol_alpha.Storage.Vote.Listings_size.context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Storage.Vote.Listings_size.value) :=
  Storage.Vote.Listings_size.get.

Definition in_listings
  : Tezos_raw_protocol_alpha.Storage.Vote.Listings.context ->
    Tezos_raw_protocol_alpha.Storage.Vote.Listings.key ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t bool :=
  Storage.Vote.Listings.mem.

Definition get_listings
  : Tezos_raw_protocol_alpha.Storage.Vote.Listings.context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (list
        (Tezos_raw_protocol_alpha.Storage.Vote.Listings.key *
          Tezos_raw_protocol_alpha.Storage.Vote.Listings.value)) :=
  Storage.Vote.Listings.bindings.

Definition clear_listings
  (ctxt : Tezos_raw_protocol_alpha.Storage.Vote.Listings.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  op_gtgteq (Storage.Vote.Listings.clear ctxt)
    (fun ctxt =>
      op_gtgteq (Storage.Vote.Listings_size.remove ctxt)
        (fun ctxt => __return ctxt)).

Definition get_current_period_kind
  : Tezos_raw_protocol_alpha.Storage.Vote.Current_period_kind.context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Storage.Vote.Current_period_kind.value) :=
  Storage.Vote.Current_period_kind.get.

Definition set_current_period_kind
  : Tezos_raw_protocol_alpha.Storage.Vote.Current_period_kind.context ->
    Tezos_raw_protocol_alpha.Storage.Vote.Current_period_kind.value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t) :=
  Storage.Vote.Current_period_kind.set.

Definition get_current_quorum
  (ctxt : Tezos_raw_protocol_alpha.Storage.Vote.Participation_ema.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int32) :=
  op_gtgteqquestion (Storage.Vote.Participation_ema.get ctxt)
    (fun participation_ema =>
      let quorum_min := Constants_storage.quorum_min ctxt in
      let quorum_max := Constants_storage.quorum_max ctxt in
      let quorum_diff := Int32.sub quorum_max quorum_min in
      __return
        (add quorum_min
          (div (mul participation_ema quorum_diff)
            (* ❌ Constant of type int32 is converted to int *)
            10000))).

Definition get_participation_ema
  : Tezos_raw_protocol_alpha.Storage.Vote.Participation_ema.context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Storage.Vote.Participation_ema.value) :=
  Storage.Vote.Participation_ema.get.

Definition set_participation_ema
  : Tezos_raw_protocol_alpha.Storage.Vote.Participation_ema.context ->
    Tezos_raw_protocol_alpha.Storage.Vote.Participation_ema.value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t) :=
  Storage.Vote.Participation_ema.set.

Definition get_current_proposal
  : Tezos_raw_protocol_alpha.Storage.Vote.Current_proposal.context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Storage.Vote.Current_proposal.value) :=
  Storage.Vote.Current_proposal.get.

Definition init_current_proposal
  : Tezos_raw_protocol_alpha.Storage.Vote.Current_proposal.context ->
    Tezos_raw_protocol_alpha.Storage.Vote.Current_proposal.value ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t) :=
  Storage.Vote.Current_proposal.init.

Definition clear_current_proposal
  : Tezos_raw_protocol_alpha.Storage.Vote.Current_proposal.context ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t) :=
  Storage.Vote.Current_proposal.delete.

Definition init (ctxt : Tezos_raw_protocol_alpha.Raw_context.context)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t) :=
  let participation_ema := Constants_storage.quorum_max ctxt in
  op_gtgteqquestion (Storage.Vote.Participation_ema.init ctxt participation_ema)
    (fun ctxt =>
      op_gtgteqquestion
        (Storage.Vote.Current_period_kind.init ctxt
          Tezos_raw_protocol_alpha.Voting_period_repr.Proposal)
        (fun ctxt => __return ctxt)).
vote_storage.mli 5 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** Manages all the voting related storage in Storage.Vote.  *)

(** Records a protocol proposal with the delegate that proposed it. *)
val record_proposal :
  Raw_context.t ->
  Protocol_hash.t ->
  Signature.Public_key_hash.t ->
  Raw_context.t tzresult Lwt.t

val recorded_proposal_count_for_delegate :
  Raw_context.t -> Signature.Public_key_hash.t -> int tzresult Lwt.t

(** Computes for each proposal how many delegates proposed it. *)
val get_proposals : Raw_context.t -> int32 Protocol_hash.Map.t tzresult Lwt.t

val clear_proposals : Raw_context.t -> Raw_context.t Lwt.t

(** Counts of the votes *)
type ballots = {yay : int32; nay : int32; pass : int32}

val ballots_encoding : ballots Data_encoding.t

val has_recorded_ballot :
  Raw_context.t -> Signature.Public_key_hash.t -> bool Lwt.t

(** Records a vote for a delegate, returns a {!Storage_error Existing_key} if
    the vote was already registered *)
val record_ballot :
  Raw_context.t ->
  Signature.Public_key_hash.t ->
  Vote_repr.ballot ->
  Raw_context.t tzresult Lwt.t

(** Computes the sum of the current ballots weighted by stake. *)
val get_ballots : Raw_context.t -> ballots tzresult Lwt.t

val get_ballot_list :
  Raw_context.t -> (Signature.Public_key_hash.t * Vote_repr.ballot) list Lwt.t

val clear_ballots : Raw_context.t -> Raw_context.t Lwt.t

val listings_encoding :
  (Signature.Public_key_hash.t * int32) list Data_encoding.t

(** Populates [!Storage.Vote.Listings] using the currently existing rolls and
    sets Listings_size. Delegates without rolls are not included in the listing. *)
val freeze_listings : Raw_context.t -> Raw_context.t tzresult Lwt.t

val clear_listings : Raw_context.t -> Raw_context.t tzresult Lwt.t

(** Returns the sum of all rolls of all delegates. *)
val listing_size : Raw_context.t -> int32 tzresult Lwt.t

(** Verifies the presence of a delegate in the listing. *)
val in_listings : Raw_context.t -> Signature.Public_key_hash.t -> bool Lwt.t

val get_listings :
  Raw_context.t -> (Signature.Public_key_hash.t * int32) list Lwt.t

val get_current_quorum : Raw_context.t -> int32 tzresult Lwt.t

val get_participation_ema : Raw_context.t -> int32 tzresult Lwt.t

val set_participation_ema :
  Raw_context.t -> int32 -> Raw_context.t tzresult Lwt.t

val get_current_period_kind :
  Raw_context.t -> Voting_period_repr.kind tzresult Lwt.t

val set_current_period_kind :
  Raw_context.t -> Voting_period_repr.kind -> Raw_context.t tzresult Lwt.t

val get_current_proposal : Raw_context.t -> Protocol_hash.t tzresult Lwt.t

val init_current_proposal :
  Raw_context.t -> Protocol_hash.t -> Raw_context.t tzresult Lwt.t

val clear_current_proposal : Raw_context.t -> Raw_context.t tzresult Lwt.t

(** Sets the initial quorum to 80% and period kind to proposal. *)
val init : Raw_context.t -> Raw_context.t tzresult Lwt.t
vote_storage_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter record_proposal :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
    ->
    Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).

Parameter recorded_proposal_count_for_delegate :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult Z).

Parameter get_proposals :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      (Tezos_protocol_environment_alpha__Environment.Protocol_hash.Map.t int32)).

Parameter clear_proposals :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    Tezos_raw_protocol_alpha.Raw_context.t.

Record ballots := {
  yay : int32;
  nay : int32;
  pass : int32 }.

Parameter ballots_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t ballots.

Parameter has_recorded_ballot :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t bool.

Parameter record_ballot :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_raw_protocol_alpha.Vote_repr.ballot ->
      Tezos_protocol_environment_alpha__Environment.Lwt.t
        (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
          Tezos_raw_protocol_alpha.Raw_context.t).

Parameter get_ballots :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult ballots).

Parameter get_ballot_list :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (list
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
        * Tezos_raw_protocol_alpha.Vote_repr.ballot)).

Parameter clear_ballots :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    Tezos_raw_protocol_alpha.Raw_context.t.

Parameter listings_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t
  (list
    (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t *
      int32)).

Parameter freeze_listings :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter clear_listings :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter listing_size :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int32).

Parameter in_listings :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t bool.

Parameter get_listings :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (list
      (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
        * int32)).

Parameter get_current_quorum :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int32).

Parameter get_participation_ema :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult int32).

Parameter set_participation_ema :
Tezos_raw_protocol_alpha.Raw_context.t ->
  int32 ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).

Parameter get_current_period_kind :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Voting_period_repr.kind).

Parameter set_current_period_kind :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_raw_protocol_alpha.Voting_period_repr.kind ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).

Parameter get_current_proposal :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)).

Parameter init_current_proposal :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)
    ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
        Tezos_raw_protocol_alpha.Raw_context.t).

Parameter clear_current_proposal :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).

Parameter init :
Tezos_raw_protocol_alpha.Raw_context.t ->
  Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.tzresult
      Tezos_raw_protocol_alpha.Raw_context.t).
voting_period_repr.ml 6 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

type t = int32

type voting_period = t

include (Compare.Int32 : Compare.S with type t := t)

let encoding = Data_encoding.int32

let pp ppf level = Format.fprintf ppf "%ld" level

let rpc_arg =
  let construct voting_period = Int32.to_string voting_period in
  let destruct str =
    match Int32.of_string str with
    | exception _ ->
        Error "Cannot parse voting period"
    | voting_period ->
        Ok voting_period
  in
  RPC_arg.make
    ~descr:"A voting period"
    ~name:"voting_period"
    ~construct
    ~destruct
    ()

let root = 0l

let succ = Int32.succ

let to_int32 l = l

let of_int32_exn l =
  if Compare.Int32.(l >= 0l) then l
  else invalid_arg "Voting_period_repr.of_int32"

type kind = Proposal | Testing_vote | Testing | Promotion_vote

let kind_encoding =
  let open Data_encoding in
  union
    ~tag_size:`Uint8
    [ case
        (Tag 0)
        ~title:"Proposal"
        (constant "proposal")
        (function Proposal -> Some () | _ -> None)
        (fun () -> Proposal);
      case
        (Tag 1)
        ~title:"Testing_vote"
        (constant "testing_vote")
        (function Testing_vote -> Some () | _ -> None)
        (fun () -> Testing_vote);
      case
        (Tag 2)
        ~title:"Testing"
        (constant "testing")
        (function Testing -> Some () | _ -> None)
        (fun () -> Testing);
      case
        (Tag 3)
        ~title:"Promotion_vote"
        (constant "promotion_vote")
        (function Promotion_vote -> Some () | _ -> None)
        (fun () -> Promotion_vote) ]
voting_period_repr_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Definition t := int32.

Definition voting_period := t.

Export Compare.Int32.

Definition encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding int32 :=
  Data_encoding.int32.

Definition pp
  (ppf : Tezos_protocol_environment_alpha__Environment.Format.formatter)
  (level : int32) : unit :=
  Format.fprintf ppf
    (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Format
      (Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int32
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.Int_d
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_padding
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.No_precision
        Tezos_protocol_environment_alpha__Environment.CamlinternalFormatBasics.End_of_format)
      "%ld" % string) level.

Definition rpc_arg
  : Tezos_protocol_environment_alpha__Environment.RPC_arg.arg int32 :=
  let construct (voting_period : int32) : string :=
    Int32.to_string voting_period in
  let destruct (str : string)
    : Tezos_protocol_environment_alpha__Environment.Pervasives.result int32
      string :=
    let 'voting_period := Int32.of_string str in
    Tezos_protocol_environment_alpha__Environment.Pervasives.Ok voting_period in
  RPC_arg.make (Some "A voting period" % string) "voting_period" % string
    destruct construct tt.

Definition root : int32 :=
  (* ❌ Constant of type int32 is converted to int *)
  0.

Definition succ : int32 -> int32 := Int32.succ.

Definition to_int32 {A : Type} (l : A) : A := l.

Definition of_int32_exn
  (l :
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.t))
  : Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.t) :=
  if
    Tezos_protocol_environment_alpha__Environment.Compare.Int32.(Tezos_protocol_environment_alpha__Environment.S.Compare.op_gteq)
      l
      (* ❌ Constant of type int32 is converted to int *)
      0 then
    l
  else
    invalid_arg "Voting_period_repr.of_int32" % string.

Inductive kind : Type :=
| Proposal : kind
| Testing_vote : kind
| Testing : kind
| Promotion_vote : kind.

Definition kind_encoding
  : Tezos_protocol_environment_alpha__Environment.Data_encoding.encoding kind :=
  union
    (Some
      (* ❌ Variants not supported *)
      variant)
    (cons
      (case "Proposal" % string None
        (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 0)
        (constant "proposal" % string)
        (fun function_parameter =>
          match function_parameter with
          | Proposal => Some tt
          | _ => None
          end)
        (fun function_parameter =>
          let 'tt := function_parameter in
          Proposal))
      (cons
        (case "Testing_vote" % string None
          (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 1)
          (constant "testing_vote" % string)
          (fun function_parameter =>
            match function_parameter with
            | Testing_vote => Some tt
            | _ => None
            end)
          (fun function_parameter =>
            let 'tt := function_parameter in
            Testing_vote))
        (cons
          (case "Testing" % string None
            (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 2)
            (constant "testing" % string)
            (fun function_parameter =>
              match function_parameter with
              | Testing => Some tt
              | _ => None
              end)
            (fun function_parameter =>
              let 'tt := function_parameter in
              Testing))
          (cons
            (case "Promotion_vote" % string None
              (Tezos_protocol_environment_alpha__Environment.Data_encoding.Tag 3)
              (constant "promotion_vote" % string)
              (fun function_parameter =>
                match function_parameter with
                | Promotion_vote => Some tt
                | _ => None
                end)
              (fun function_parameter =>
                let 'tt := function_parameter in
                Promotion_vote)) [])))).
voting_period_repr.mli 2 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

(** A voting period can be of 4 kinds and is uniquely identified as a counter
    since the root. *)

type t

type voting_period = t

val encoding : voting_period Data_encoding.t

val rpc_arg : voting_period RPC_arg.arg

val pp : Format.formatter -> voting_period -> unit

include Compare.S with type t := voting_period

val to_int32 : voting_period -> int32

val of_int32_exn : int32 -> voting_period

val root : voting_period

val succ : voting_period -> voting_period

type kind =
  | Proposal  (** protocols can be proposed *)
  | Testing_vote  (** a proposal can be voted *)
  | Testing  (** winning proposal is forked on a testnet *)
  | Promotion_vote  (** activation can be voted *)

val kind_encoding : kind Data_encoding.t
voting_period_repr_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter t : Type.

Definition voting_period := t.

Parameter encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t voting_period.

Parameter rpc_arg :
Tezos_protocol_environment_alpha__Environment.RPC_arg.arg voting_period.

Parameter pp :
Tezos_protocol_environment_alpha__Environment.Format.formatter ->
  voting_period -> unit.

include

Parameter to_int32 : voting_period -> int32.

Parameter of_int32_exn : int32 -> voting_period.

Parameter root : voting_period.

Parameter succ : voting_period -> voting_period.

Inductive kind : Type :=
| Proposal : kind
| Testing_vote : kind
| Testing : kind
| Promotion_vote : kind.

Parameter kind_encoding :
Tezos_protocol_environment_alpha__Environment.Data_encoding.t kind.
voting_services.ml 111 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

module S = struct
  let path = RPC_path.(open_root / "votes")

  let ballots =
    RPC_service.get_service
      ~description:"Sum of ballots casted so far during a voting period."
      ~query:RPC_query.empty
      ~output:Vote.ballots_encoding
      RPC_path.(path / "ballots")

  let ballot_list =
    RPC_service.get_service
      ~description:"Ballots casted so far during a voting period."
      ~query:RPC_query.empty
      ~output:
        Data_encoding.(
          list
            (obj2
               (req "pkh" Signature.Public_key_hash.encoding)
               (req "ballot" Vote.ballot_encoding)))
      RPC_path.(path / "ballot_list")

  let current_period_kind =
    RPC_service.get_service
      ~description:"Current period kind."
      ~query:RPC_query.empty
      ~output:Voting_period.kind_encoding
      RPC_path.(path / "current_period_kind")

  let current_quorum =
    RPC_service.get_service
      ~description:"Current expected quorum."
      ~query:RPC_query.empty
      ~output:Data_encoding.int32
      RPC_path.(path / "current_quorum")

  let listings =
    RPC_service.get_service
      ~description:
        "List of delegates with their voting weight, in number of rolls."
      ~query:RPC_query.empty
      ~output:Vote.listings_encoding
      RPC_path.(path / "listings")

  let proposals =
    RPC_service.get_service
      ~description:"List of proposals with number of supporters."
      ~query:RPC_query.empty
      ~output:(Protocol_hash.Map.encoding Data_encoding.int32)
      RPC_path.(path / "proposals")

  let current_proposal =
    RPC_service.get_service
      ~description:"Current proposal under evaluation."
      ~query:RPC_query.empty
      ~output:(Data_encoding.option Protocol_hash.encoding)
      RPC_path.(path / "current_proposal")
end

let register () =
  let open Services_registration in
  register0 S.ballots (fun ctxt () () -> Vote.get_ballots ctxt) ;
  register0 S.ballot_list (fun ctxt () () -> Vote.get_ballot_list ctxt >|= ok) ;
  register0 S.current_period_kind (fun ctxt () () ->
      Vote.get_current_period_kind ctxt) ;
  register0 S.current_quorum (fun ctxt () () -> Vote.get_current_quorum ctxt) ;
  register0 S.proposals (fun ctxt () () -> Vote.get_proposals ctxt) ;
  register0 S.listings (fun ctxt () () -> Vote.get_listings ctxt >|= ok) ;
  register0 S.current_proposal (fun ctxt () () ->
      (* this would be better implemented using get_option in get_current_proposal *)
      Vote.get_current_proposal ctxt
      >>= function
      | Ok p ->
          return_some p
      | Error (Raw_context.Storage_error (Missing_key _) :: _) ->
          return_none
      | Error _ as e ->
          Lwt.return e)

let ballots ctxt block = RPC_context.make_call0 S.ballots ctxt block () ()

let ballot_list ctxt block =
  RPC_context.make_call0 S.ballot_list ctxt block () ()

let current_period_kind ctxt block =
  RPC_context.make_call0 S.current_period_kind ctxt block () ()

let current_quorum ctxt block =
  RPC_context.make_call0 S.current_quorum ctxt block () ()

let listings ctxt block = RPC_context.make_call0 S.listings ctxt block () ()

let proposals ctxt block = RPC_context.make_call0 S.proposals ctxt block () ()

let current_proposal ctxt block =
  RPC_context.make_call0 S.current_proposal ctxt block () ()
voting_services_ml.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Import Alpha_context.

Module S.
  Definition path
    : Tezos_protocol_environment_alpha__Environment.RPC_path.path
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context :=
    op_div open_root "votes" % string.
  
  Definition ballots
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
      unit Tezos_raw_protocol_alpha.Alpha_context.Vote.ballots :=
    RPC_service.get_service
      (Some "Sum of ballots casted so far during a voting period." % string)
      RPC_query.empty Vote.ballots_encoding (op_div path "ballots" % string).
  
  Definition ballot_list
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
      unit
      (list
        (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
          * Tezos_raw_protocol_alpha.Alpha_context.Vote.ballot)) :=
    RPC_service.get_service
      (Some "Ballots casted so far during a voting period." % string)
      RPC_query.empty
      (list None
        (obj2 (req None None "pkh" % string Signature.Public_key_hash.encoding)
          (req None None "ballot" % string Vote.ballot_encoding)))
      (op_div path "ballot_list" % string).
  
  Definition current_period_kind
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
      unit Tezos_raw_protocol_alpha.Alpha_context.Voting_period.kind :=
    RPC_service.get_service (Some "Current period kind." % string)
      RPC_query.empty Voting_period.kind_encoding
      (op_div path "current_period_kind" % string).
  
  Definition current_quorum
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
      unit int32 :=
    RPC_service.get_service (Some "Current expected quorum." % string)
      RPC_query.empty Data_encoding.int32
      (op_div path "current_quorum" % string).
  
  Definition listings
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
      unit
      (list
        (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
          * int32)) :=
    RPC_service.get_service
      (Some
        "List of delegates with their voting weight, in number of rolls." %
          string) RPC_query.empty Vote.listings_encoding
      (op_div path "listings" % string).
  
  Definition proposals
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
      unit
      (Tezos_protocol_environment_alpha__Environment.Protocol_hash.Map.t int32) :=
    RPC_service.get_service
      (Some "List of proposals with number of supporters." % string)
      RPC_query.empty (Protocol_hash.Map.encoding Data_encoding.int32)
      (op_div path "proposals" % string).
  
  Definition current_proposal
    : Tezos_protocol_environment_alpha__Environment.RPC_service.service variant
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context
      Tezos_protocol_environment_alpha__Environment.Updater.rpc_context unit
      unit
      (option
        Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t)) :=
    RPC_service.get_service (Some "Current proposal under evaluation." % string)
      RPC_query.empty
      (Data_encoding.option
        Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.encoding))
      (op_div path "current_proposal" % string).
End S.

Definition register (function_parameter : unit) : unit :=
  let 'tt := function_parameter in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register0 S.ballots
      (fun ctxt =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            Vote.get_ballots ctxt) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register0 S.ballot_list
      (fun ctxt =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            op_gtpipeeq (Vote.get_ballot_list ctxt) ok) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register0 S.current_period_kind
      (fun ctxt =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            Vote.get_current_period_kind ctxt) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register0 S.current_quorum
      (fun ctxt =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            Vote.get_current_quorum ctxt) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register0 S.proposals
      (fun ctxt =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            Vote.get_proposals ctxt) in
  (* ❌ Sequences of instructions are not handled (operator ";") *)
  let _ :=
    register0 S.listings
      (fun ctxt =>
        fun function_parameter =>
          let 'tt := function_parameter in
          fun function_parameter =>
            let 'tt := function_parameter in
            op_gtpipeeq (Vote.get_listings ctxt) ok) in
  register0 S.current_proposal
    (fun ctxt =>
      fun function_parameter =>
        let 'tt := function_parameter in
        fun function_parameter =>
          let 'tt := function_parameter in
          op_gtgteq (Vote.get_current_proposal ctxt)
            (fun function_parameter =>
              match function_parameter with
              | Tezos_protocol_environment_alpha__Environment.Pervasives.Ok p =>
                return_some p
              |
                Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                  (cons
                    (Tezos_protocol_environment_alpha__Environment.Error_monad.Storage_error
                      (Tezos_raw_protocol_alpha.Raw_context.Missing_key _ _)) _)
                => return_none
              |
                (Tezos_protocol_environment_alpha__Environment.Pervasives.Error
                  _) as e => Lwt.__return e
              end)).

Definition ballots {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Vote.ballots) :=
  RPC_context.make_call0 S.ballots ctxt block tt tt.

Definition ballot_list {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (list
        (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
          * Tezos_raw_protocol_alpha.Alpha_context.Vote.ballot))) :=
  RPC_context.make_call0 S.ballot_list ctxt block tt tt.

Definition current_period_kind {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      Tezos_raw_protocol_alpha.Alpha_context.Voting_period.kind) :=
  RPC_context.make_call0 S.current_period_kind ctxt block tt tt.

Definition current_quorum {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      int32) := RPC_context.make_call0 S.current_quorum ctxt block tt tt.

Definition listings {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (list
        (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
          * int32))) := RPC_context.make_call0 S.listings ctxt block tt tt.

Definition proposals {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (Tezos_protocol_environment_alpha__Environment.Protocol_hash.Map.t int32)) :=
  RPC_context.make_call0 S.proposals ctxt block tt tt.

Definition current_proposal {D E G I K L a b c i o q : Type}
  (ctxt :
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
      D ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (E * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o
        ->
        D ->
          a ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (G * a * q * i * o)) *
        (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
          Tezos_protocol_environment_alpha__Environment.RPC_context.t
          ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          q i o ->
          D ->
            a ->
              b ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (I * a * b * q * i * o)) *
          (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
            Tezos_protocol_environment_alpha__Environment.RPC_context.t
            (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a)
              * b) * c) q i o ->
            D ->
              a ->
                b ->
                  c ->
                    q ->
                      i ->
                        Tezos_protocol_environment_alpha__Environment.Lwt.t
                          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                            o)) * (K * a * b * c * q * i * o)) * L)))) * L * D)
  (block : D)
  : Tezos_protocol_environment_alpha__Environment.Lwt.t
    (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
      (option
        Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))) :=
  RPC_context.make_call0 S.current_proposal ctxt block tt tt.
voting_services.mli 136 errors 
(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Alpha_context

val ballots : 'a #RPC_context.simple -> 'a -> Vote.ballots shell_tzresult Lwt.t

val ballot_list :
  'a #RPC_context.simple ->
  'a ->
  (Signature.Public_key_hash.t * Vote.ballot) list shell_tzresult Lwt.t

val current_period_kind :
  'a #RPC_context.simple -> 'a -> Voting_period.kind shell_tzresult Lwt.t

val current_quorum :
  'a #RPC_context.simple -> 'a -> Int32.t shell_tzresult Lwt.t

val listings :
  'a #RPC_context.simple ->
  'a ->
  (Signature.Public_key_hash.t * int32) list shell_tzresult Lwt.t

val proposals :
  'a #RPC_context.simple ->
  'a ->
  Int32.t Protocol_hash.Map.t shell_tzresult Lwt.t

val current_proposal :
  'a #RPC_context.simple -> 'a -> Protocol_hash.t option shell_tzresult Lwt.t

val register : unit -> unit
voting_services_mli.v 
Require Import OCaml.OCaml.

Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Parameter ballots : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_raw_protocol_alpha.Alpha_context.Vote.ballots).

Parameter ballot_list : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (list
          (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
            * Tezos_raw_protocol_alpha.Alpha_context.Vote.ballot))).

Parameter current_period_kind : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_raw_protocol_alpha.Alpha_context.Voting_period.kind).

Parameter current_quorum : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        Tezos_protocol_environment_alpha__Environment.Int32.t).

Parameter listings : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (list
          (Tezos_protocol_environment_alpha__Environment.Signature.Public_key_hash.t
            * int32))).

Parameter proposals : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (Tezos_protocol_environment_alpha__Environment.Protocol_hash.Map.t
          Tezos_protocol_environment_alpha__Environment.Int32.t)).

Parameter current_proposal : forall {_ a b c i o q variant : Type},
(((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
  Tezos_protocol_environment_alpha__Environment.RPC_context.t
  Tezos_protocol_environment_alpha__Environment.RPC_context.t q i o ->
  a ->
    q ->
      i ->
        Tezos_protocol_environment_alpha__Environment.Lwt.t
          (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
            o)) * (_ * q * i * o)) *
  (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
    Tezos_protocol_environment_alpha__Environment.RPC_context.t
    (Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) q i o ->
    a ->
      a ->
        q ->
          i ->
            Tezos_protocol_environment_alpha__Environment.Lwt.t
              (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                o)) * (_ * a * q * i * o)) *
    (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
      Tezos_protocol_environment_alpha__Environment.RPC_context.t
      ((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b) q
      i o ->
      a ->
        a ->
          b ->
            q ->
              i ->
                Tezos_protocol_environment_alpha__Environment.Lwt.t
                  (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                    o)) * (_ * a * b * q * i * o)) *
      (((Tezos_protocol_environment_alpha__Environment.RPC_service.t variant
        Tezos_protocol_environment_alpha__Environment.RPC_context.t
        (((Tezos_protocol_environment_alpha__Environment.RPC_context.t * a) * b)
          * c) q i o ->
        a ->
          a ->
            b ->
              c ->
                q ->
                  i ->
                    Tezos_protocol_environment_alpha__Environment.Lwt.t
                      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
                        o)) * (_ * a * b * c * q * i * o)) * _)))) * _ * a ->
  a ->
    Tezos_protocol_environment_alpha__Environment.Lwt.t
      (Tezos_protocol_environment_alpha__Environment.Error_monad.shell_tzresult
        (option
          Tezos_protocol_environment_alpha__Environment.Protocol_hash.(Tezos_protocol_environment_alpha__Environment.HASH.S.t))).

Parameter register : unit -> unit.

Sources are on GitHub. © Guillaume Claret.